ROUTINE PSGL*31,111*

Up To ROUTINE PSGL
PSGL * * 112 LINES,  5533 BYTES,  RSUM: 16976215/35127952  Page 1 UCI: EHR,EHR   Site: Central Regional Hospital MAY 17,2015@21:40

PSGL^PSGL CODE
1 PSGL  ;BIR/CML3-LABEL PRINT/REPRINT ;25 SEP 97 / 7:41 AM  2 +1     ;;5.0; INPATIENT MEDICATIONS ;**31,111**;16 DEC 97 3 +2    ;  4 +3     ; Reference to ^PS(55 is supported by DBIA# 2191  5 +4     ;  6 +5     N PSGPTMP,PSJNEW,PPAGE,PSGEFN S PSJNEW=1  7 +6     D ENCV^PSGSETU Q:$D(XQUIT)  K PSGLSTOP S %=1 F PSGTOL=1,3 I $O(^PS(            53.41,PSGTOL,1,0)) D ENACL^PSGL0  8 +7     G:%<0 DONE

CHK^PSGL CODE
9 CHK   ; 10 +1    I '$O(^PS(53.41,2,1,DUZ,1,0)) G ASK 11 +2    F  W !!,"You have unprinted new labels.  Do you want them now" S %= 1 D YN^DICN Q:% D CHKM^PSGLH 12 +3    G:%<0 DONE I %=1 D ENNL^PSGL0 G ASK 13 +4    F  W !!,"Will you want them later" S %=1 D YN^DICN Q:%  D LM^PSGLH 14 +5    G:%<0 DONE I %=2 S DIK="^PS(53.41,2,1,",DA=DUZ,DA(1)=2 D ^DIK 15 +6     ;

ASK^PSGL CODE
16 ASK   ; 17 +1    S PSGSSH="LBL" F  D ^PSGSEL Q:"^"[PSGSS  K PSGLWD,PSGLWG S PSGPTMP= 0,PPAGE=1 D @PSGSS Q:+Y'>0 K ZTSAVE,IO("Q") S POP=0,Y=1 D:PSGSS'= "P" DT Q:Y'>0 D:PSGSS'="P" DEV Q:POP!$D(IO("Q"))  D @("EN"_PSGSS) D ^%ZISC 18 +2    ;

DONE^PSGL CODE
19 DONE  ; 20 +1    D ENKV^PSGSETU K CF,DFN,NG,OD,ON,PSGCNT,PSGLMT,PSGODDD,PSGOL,PSGON, PSGOP,PSGORD,PSGODT,PSGSS,PSGPL1,PSGPL2,PSGPL3,PSGSSH,PSIVREA,PSJO N,PSJOL,PSJORD,PSJIVOF,PSJOCNT,PSJON,RF,QO,QS,QSD,Q1,Q2,WG,ZTSAVE 21 +2    K ORPV,ORSTOP,ORSTRT,ORSTS,P17 Q 22 +3     ;

DEV^PSGL CODE
23 DEV   ; 24 +1    K ZTSK,%ZIS,IOP,IO("Q") S PSGION=ION,%ZIS="Q",%ZIS("A")="Label Prin            ting Device: ",%ZIS("B")=$P(PSJSYSL,"^",2) W ! D ^%ZIS K %ZIS I PO           P S IOP=PSGION D ^%ZIS K IOP S POP=1 W !?3,"(No device chosen for             label print.)" Q 25 +2     D EN2^PSGLBA S POP=0 Q:'$D(IO("Q")) 26 +3    S ZTDESC="UD LABEL PRINT",PSGTIR=$S(PSGSS'="P":"EN"_PSGSS,1:"ENPLP"            )_"^PSGL" I PSGSS="G" F X="PSGLBLD","PSGLWG","PSGLWGN" S ZTSAVE(X) ="" 27 +4    I PSGSS="W" F X="PSGLBLD","PSGLWD","PSGLWDN" S ZTSAVE(X)="" 28 +5    I PSGSS="P" F X="PSGP","PSGP(0)","PSJPAGE","PSJPDOB","PSJPDX","PSJP            RB","PSJPSEX","PSJPSSN","PSJPWD","PSJPWDN","PSGODDD","PSGODDD(","V            A(""PID"")","VA(""BID"")","^TMP(""PSJON"",$J," S ZTSAVE(X)="" 29 +6    W ! D ENTSK^PSGTI W !,"Labels ",$S($D(ZTSK):"",1:"NOT "),"queued!" 30 +7    Q 31 +8     ;

G^PSGL CODE
32 G     ; 33 +1    K DIC S DIC="^PS(57.5,",DIC(0)="QEAMIZ",DIC("A")="Select WARD GROUP            : " W ! D ^DIC K DIC D  Q 34 +2     . I X="^OTHER" S (PSGLWG,PSGLWGN)="^OTHER",Y=1 Q 35 +3     . I Y>0 S PSGLWG=+Y,PSGLWGN=Y(0,0) 36 +4     ;

W^PSGL CODE
37 W     ; 38 +1    K DIC S DIC="^DIC(42,",DIC(0)="QEAMIZ",DIC("A")="Select WARD: " W !             D ^DIC K DIC S:Y>0 PSGLWD=+Y,PSGLWDN=Y(0,0) Q 39 +2     ;

P^PSGL CODE
40 P     ; 41 +1    K PSJPR D ^PSJP S Y=PSGP Q 42 +2     ;

C^PSGL CODE
43 C     ; 44 +1    K DIR S DIR(0)="FAO",DIR("A")="Select CLINIC: " 45 +2    S DIR("?")="^D CDIC^PSGVBW" W ! D ^DIR

CDIC^PSGL CODE
46 CDIC  ; 47 +1    K DIC S DIC="^SC(",DIC(0)="QEMIZ" D ^DIC K DIC S:+Y>0 CL=+Y 48 +2     W:X["?" !!,"Enter the clinic you want to use to select patients for             processing.",! 49 +3     Q

L^PSGL CODE
50 L     ; 51 +1    K DIR S DIR(0)="FAO",DIR("A")="Select CLINIC GROUP: " 52 +2    S DIR("?")="^D LDIC^PSGVBW" W ! D ^DIR

LDIC^PSGL CODE
53 LDIC  ; 54 +1    K DIC S DIC="^PS(57.8,",DIC(0)="QEMI" D ^DIC K DIC S:+Y>0 CG=+Y 55 +2     W:X["?" !!,"Enter the name of the clinic group you want to use to s            elect patients for processing." 56 +3     Q

ENG^PSGL CODE
57 ENG   ; 58 +1    F PSGLWD=0:0 S PSGLWD=$O(^PS(57.5,"AC",PSGLWG,PSGLWD)) Q:'PSGLWD  S             PSGLWDN=$P($G(^DIC(42,PSGLWD,0)),"^") D ENW1 59 +2    Q 60 +3     ;

ENW^PSGL CODE
61 ENW   ; 62 +1    S PSGLWG=$O(^PS(57.5,"AB",PSGLWD,0)),PSGLWGN="" I PSGLWG,$D(^PS(57. 5,PSGLWG,0)),$P(^(0),"^")]"" S PSGLWG=$P(^(0),"^") 63 +2    ;

ENW1^PSGL CODE
64 ENW1  ; 65 +1    D NOW^%DTC S PSGDT=% U IO F PSGOP=0:0 S (DFN,PSGOP,PSGP)=$O(^DPT("C            N",PSGLWDN,PSGOP)) Q:'PSGOP  D IWP 66 +2    Q

IWP^PSGL CODE
67 IWP   ; 68 +1    N PSJFIRST,PSJACND S (PSJACND,PSJFIRST)=1 K PSJACNWP D ^PSJAC,ENPVS ET^PSGLPI 69 +2    F QSD=PSGLAD:0 S QSD=$O(^PS(55,PSGOP,5,"AUS",QSD)) Q:'QSD  F ON=0:0 S ON=$O(^PS(55,PSGOP,5,"AUS",QSD,ON)) Q:'ON D 70 +3     .I PSJFIRST,$P(PSJSYSW0,U,18) D ENHEDER^PSGLPI S PSJFIRST=0 71 +4    .I $D(^PS(55,PSGOP,5,ON,7)),+^(7)'<PSGLBLD S PSGORD=ON_"A" D ^PSGLO I,KL 72 +5    F ON=0:0 S ON=$O(^PS(53.1,"AC",PSGOP,ON)) Q:'ON  D 73 +6     .I PSJFIRST,$P(PSJSYSW0,U,18) D ENHEDER^PSGLPI S PSJFIRST=0 74 +7    .I $D(^PS(53.1,ON,7)),+^(7)'<PSGLBLD S PSGORD=ON_"N" D ^PSGLOI,KL 75 +8    Q 76 +9     ;

ENL^PSGL CODE
77 ENL   S CL="" F  S CL=$O(^PS(57.8,"AD",CG,CL)) Q:CL=""  D ENC 78 +1    Q

ENC^PSGL CODE
79 ENC   ; 80 +1    K ^TMP("PSJCI",$J) 81 +2    S STDTE=0 F  S STDTE=$O(^PS(55,"AUDC",STDTE)) Q:'STDTE  S CLINIC=0 F S CLINIC=$O(^PS(55,"AUDC",STDTE,CLINIC)) Q:'CLINIC  D 82 +3. S JDFN=0 F S JDFN=$O(^PS(55,"AUDC",STDTE,CLINIC,JDFN)) Q:'JDFN S ^TMP("PSJCI",$J,JDFN)="" 83 +4    S DFN="" F  S DFN=$O(^TMP("PSJCI",$J,DFN)) Q:'DFN  S (PSGOP,PSGP)=D FN D IWP 84 +5    Q

ENP^PSGL CODE
85 ENP   ; 86 +1    ;D ENL^PSJO3 Q:"^N"[PSJOL  S PSJOS=$P(PSJSYSP0,"^",11),PSGLPF=1 D ^ PSJO K PSGLPF Q:'PSJON S PSGLMT=PSJON 87 +2    D ENL^PSJO3 Q:"^N"[PSJOL  S PSJOS=$P(PSJSYSP0,"^",11) D ^PSJO K PSG LPF Q:'PSJON S PSGLMT=PSJON 88 +3    F  R !!,"Select orders for labels: ",X:DTIME W:'$T $C(7) S:'$T X="^            " Q:"^"[X  D  Q:$D(X) 89 +4    .I X?2."?" D H2^PSGON K X Q 90 +5    .I X?1."?" W !!?2,"Select the orders for which you want labels prin           ted." K X Q 91 +6    .I X="A" D AADR^PSJUTL K X Q 92 +7     .I X'?1."?" D ^PSGON W:'$D(X) $C(7)," ??" Q 93 +8    I "^"[X K ^TMP("PSJON",$J) Q 94 +9     D DEV I POP!$D(IO("Q")) K ^TMP("PSJON",$J) Q 95 +10    ;

ENPLP^PSGL CODE
96 ENPLP ; 97 +1    D NOW^%DTC S PSGDT=+$E(%,1,12),(DFN,PSGOP)=PSGP D:$D(ZTSK) ^PSJAC D             ENPVSET^PSGLPI U IO 98 +2     N PSJFIRST S PSJFIRST=1 F PSGPL1=1:1:PSGODDD F PSGPL2=1:1 S PSGPL3= $P(PSGODDD(PSGPL1),",",PSGPL2) Q:'PSGPL3 S (PSGORD,PSJORD)=^TMP("            PSJON",$J,PSGPL3) D 99 +3     .I PSJFIRST,$P(PSJSYSW0,U,18) D ENHEDER^PSGLPI S PSJFIRST=0 100 +4    .I PSGORD["V" D EN^PSIVUDL(DFN,PSGORD,PSGLWD_U_PSGLWDN,PSGLRB),KL Q 101 +5     .I PSGORD'["P" D ^PSGLOI,KL Q 102 +6     .S X=$P($G(^PS(53.1,+PSGORD,0)),"^",4) I X="F" D EN^PSIVUDL(DFN,PSG            ORD,PSGLWD_U_PSGLWDN,PSGLRB),KL Q 103 +7     .D ^PSGLOI,KL 104 +8    Q 105 +9     ;

DT^PSGL CODE
106 DT    ; 107 +1    F  K %DT S %DT="ET",%DT(0)="-NOW" R !!,"Enter label start date: ",X :DTIME D:X?1."?" DTM^PSGLH D ^%DT K %DT I Y>0!("^"[X) S PSGLBLD=Y, ZTSAVE("PSGLBLD")="" Q 108 +2    W:Y'>0 $C(7),!?3,"(No date selected for label print.)" Q 109 +3     ;

KL^PSGL CODE
110 KL    ; kill other label records for the same order 111 +1    S QS=$S(PSGORD["V":3,PSGORD["N":2,1:1) K ^PS(53.41,2,1,DUZ,1,PSGOP,            1,QS,+PSGORD) 112 +2    Q