PSGLW ;BIR/CML3-LABEL QUEUE AND WRITE ;12 JUN 96 / 2:30 PM
;;5.0; INPATIENT MEDICATIONS ;**115**;16 DEC 97
;
ENQL ;
Q:$G(PSGOP)'>0
I '$G(PSJSYSW0) S PSJSYSW0=+$O(^PS(59.6,"B",$S($G(PSJPWD):$G(PSJPWD),1:+$G(PSGLWD)),0))
I $S($D(IO)[0:1,1:$P(PSJSYSL,"^",3)'=IO) S IOP=$P(PSJSYSL,"^",2)_";132",%ZIS="NQ" D ^%ZIS K IOP,POP,ZTSAVE S PSGTID=$H,PSGTIR="ENLP^PSGLW",ZTDESC="MAR LABEL PRINT",ZTSAVE("PSGOP")="" D ENTSK^PSGTI K ZTSK Q
F S IOP=$P(PSJSYSL,"^",2)_";132",%ZIS="" D ^%ZIS Q:'POP
;
ENLP ;
K PSGLSTOP D ^PSGLPI,NOW^%DTC N PSJFIRST S PSJFIRST=1 S PSGDT=% U IO
F PSGLWP1=1,2,3 F PSGLWP2=0:0 S PSGLWP2=$O(^PS(53.41,2,1,DUZ,1,PSGOP,1,PSGLWP1,1,PSGLWP2)) Q:'PSGLWP2 D
. I PSJFIRST,$P(PSJSYSW0,U,18) D ENHEDER^PSGLPI S PSJFIRST=0
. S PSGORD=PSGLWP2_$E("ANV",PSGLWP1) NEW PSJFLUID
. I PSGLWP1=2,($P($G(^PS(53.1,+PSGORD,0)),U,9)="P") S PSGORD=+PSGORD_"P" S:$P(^(0),U,4)="F" PSJFLUID=1
. D @$S((PSGLWP1=3!$G(PSJFLUID)):"EN^PSIVUDL(PSGOP,PSGORD,PSGLWD_U_PSGLWDN,PSGLRB)",1:"^PSGLOI")
. K ^PS(53.41,2,1,DUZ,1,PSGOP,1,PSGLWP1,1,PSGLWP2)
K ^PS(53.41,2,1,DUZ,1,PSGOP) D ^%ZISC
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGLW 1102 printed Dec 13, 2024@02:01:25 Page 2
PSGLW ;BIR/CML3-LABEL QUEUE AND WRITE ;12 JUN 96 / 2:30 PM
+1 ;;5.0; INPATIENT MEDICATIONS ;**115**;16 DEC 97
+2 ;
ENQL ;
+1 if $GET(PSGOP)'>0
QUIT
+2 IF '$GET(PSJSYSW0)
SET PSJSYSW0=+$ORDER(^PS(59.6,"B",$SELECT($GET(PSJPWD):$GET(PSJPWD),1:+$GET(PSGLWD)),0))
+3 IF $SELECT($DATA(IO)[0:1,1:$PIECE(PSJSYSL,"^",3)'=IO)
SET IOP=$PIECE(PSJSYSL,"^",2)_";132"
SET %ZIS="NQ"
DO ^%ZIS
KILL IOP,POP,ZTSAVE
SET PSGTID=$HOROLOG
SET PSGTIR="ENLP^PSGLW"
SET ZTDESC="MAR LABEL PRINT"
SET ZTSAVE("PSGOP")=""
DO ENTSK^PSGTI
KILL ZTSK
QUIT
+4 FOR
SET IOP=$PIECE(PSJSYSL,"^",2)_";132"
SET %ZIS=""
DO ^%ZIS
if 'POP
QUIT
+5 ;
ENLP ;
+1 KILL PSGLSTOP
DO ^PSGLPI
DO NOW^%DTC
NEW PSJFIRST
SET PSJFIRST=1
SET PSGDT=%
USE IO
+2 FOR PSGLWP1=1,2,3
FOR PSGLWP2=0:0
SET PSGLWP2=$ORDER(^PS(53.41,2,1,DUZ,1,PSGOP,1,PSGLWP1,1,PSGLWP2))
if 'PSGLWP2
QUIT
Begin DoDot:1
+3 IF PSJFIRST
IF $PIECE(PSJSYSW0,U,18)
DO ENHEDER^PSGLPI
SET PSJFIRST=0
+4 SET PSGORD=PSGLWP2_$EXTRACT("ANV",PSGLWP1)
NEW PSJFLUID
+5 IF PSGLWP1=2
IF ($PIECE($GET(^PS(53.1,+PSGORD,0)),U,9)="P")
SET PSGORD=+PSGORD_"P"
if $PIECE(^(0),U,4)="F"
SET PSJFLUID=1
+6 DO @$SELECT((PSGLWP1=3!$GET(PSJFLUID)):"EN^PSIVUDL(PSGOP,PSGORD,PSGLWD_U_PSGLWDN,PSGLRB)",1:"^PSGLOI")
+7 KILL ^PS(53.41,2,1,DUZ,1,PSGOP,1,PSGLWP1,1,PSGLWP2)
End DoDot:1
+8 KILL ^PS(53.41,2,1,DUZ,1,PSGOP)
DO ^%ZISC
+9 QUIT
