PSJLOI ;BIR/MV-PRINT ACKNOWLEGED PENDING LABELS ;16 DEC 97 / 9:32 AM
;;5.0; INPATIENT MEDICATIONS ;**28,54**;16 DEC 97
;
; Reference to ^PS(55 supported by DBIA #2191.
; Reference to ^DPT supported by DBIA #10035.
; Reference to ^%DTC supported by DBIA #10000.
;
;Queue MAR labels for Acknowleged pending orders.
EN(DFN,ON) ;
N P,X,Y,PSGTOL,PSGUOW,PSGP,PSGTOO,DA
S PSGP=DFN
Q:'$D(^DPT(PSGP,.1)) N PSJACPF,PSJACNWP S PSJACPF=11 D ENCV^PSGSETU S Y=DFN D CHK^PSGP Q:'PSJSYSL
S DA=+ON
S ND0=^PS(53.1,DA,0)
S PSGTOL=2,PSGUOW=DUZ,PSGTOO=2
S X=$P(PSJSYSW0,U,2) I X="" S X=1
S Y=$P($G(^PS(53.1,DA,8)),U),Y=$S(Y="A":4,Y="H":5,Y="C":6,1:1)
I X=1!($P(ND0,U,4)'="U"&(X[Y!(Y=1)))!($P(ND0,U,4)="U"&(X=2)) D
. D NOW^%DTC S PSGDT=% D ENL^PSGVDS
S ^PS(53.1,DA,7)=PSGDT_U_"N"
I $P(PSJSYSL,U,2)]"" S PSGOP=DFN D ^PSGLW
Q
;
EN2(DFN,ON) ;
N PSGTOL,PSGUOW,PSGP,PSGTOO,DA
S PSGP=DFN
Q:'$D(^DPT(PSGP,.1)) N PSJACPF,PSJACNWP S PSJACPF=11 D ENCV^PSGSETU S Y=DFN D CHK^PSGP Q:'PSJSYSL
S DA=+ON
S PSGTOL=2,PSGUOW=DUZ,PSGTOO=1
I +PSJSYSL>1 S $P(^PS(55,PSGP,5,DA,7),U)=PSGDT S:$P(^(7),U,2)="" $P(^(7),U,2)="N"_$S($P(^PS(55,PSGP,5,DA,0),U,24)="E":"E",1:"") S PSGOP=DFN D ^PSGLW
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJLOI 1227 printed Nov 22, 2024@17:17:41 Page 2
PSJLOI ;BIR/MV-PRINT ACKNOWLEGED PENDING LABELS ;16 DEC 97 / 9:32 AM
+1 ;;5.0; INPATIENT MEDICATIONS ;**28,54**;16 DEC 97
+2 ;
+3 ; Reference to ^PS(55 supported by DBIA #2191.
+4 ; Reference to ^DPT supported by DBIA #10035.
+5 ; Reference to ^%DTC supported by DBIA #10000.
+6 ;
+7 ;Queue MAR labels for Acknowleged pending orders.
EN(DFN,ON) ;
+1 NEW P,X,Y,PSGTOL,PSGUOW,PSGP,PSGTOO,DA
+2 SET PSGP=DFN
+3 if '$DATA(^DPT(PSGP,.1))
QUIT
NEW PSJACPF,PSJACNWP
SET PSJACPF=11
DO ENCV^PSGSETU
SET Y=DFN
DO CHK^PSGP
if 'PSJSYSL
QUIT
+4 SET DA=+ON
+5 SET ND0=^PS(53.1,DA,0)
+6 SET PSGTOL=2
SET PSGUOW=DUZ
SET PSGTOO=2
+7 SET X=$PIECE(PSJSYSW0,U,2)
IF X=""
SET X=1
+8 SET Y=$PIECE($GET(^PS(53.1,DA,8)),U)
SET Y=$SELECT(Y="A":4,Y="H":5,Y="C":6,1:1)
+9 IF X=1!($PIECE(ND0,U,4)'="U"&(X[Y!(Y=1)))!($PIECE(ND0,U,4)="U"&(X=2))
Begin DoDot:1
+10 DO NOW^%DTC
SET PSGDT=%
DO ENL^PSGVDS
End DoDot:1
+11 SET ^PS(53.1,DA,7)=PSGDT_U_"N"
+12 IF $PIECE(PSJSYSL,U,2)]""
SET PSGOP=DFN
DO ^PSGLW
+13 QUIT
+14 ;
EN2(DFN,ON) ;
+1 NEW PSGTOL,PSGUOW,PSGP,PSGTOO,DA
+2 SET PSGP=DFN
+3 if '$DATA(^DPT(PSGP,.1))
QUIT
NEW PSJACPF,PSJACNWP
SET PSJACPF=11
DO ENCV^PSGSETU
SET Y=DFN
DO CHK^PSGP
if 'PSJSYSL
QUIT
+4 SET DA=+ON
+5 SET PSGTOL=2
SET PSGUOW=DUZ
SET PSGTOO=1
+6 IF +PSJSYSL>1
SET $PIECE(^PS(55,PSGP,5,DA,7),U)=PSGDT
if $PIECE(^(7),U,2)=""
SET $PIECE(^(7),U,2)="N"_$SELECT($PIECE(^PS(55,PSGP,5,DA,0),U,24)="E":"E",1:"")
SET PSGOP=DFN
DO ^PSGLW
+7 QUIT
+8
***** ERRORS & WARNINGS IN PSJLOI *****
PSJLOI+1 S - 2nd line of routine violates the SAC.
