PSGSETU ;BIR/CML3-PACKAGE UTILITIES ;10 Mar 99 / 10:53 AM
;;5.0; INPATIENT MEDICATIONS ;**3,11,26,39,58,115,133,181**;16 DEC 97;Build 190
;
; Reference to TERM^VALM0 is supported by DBIA #2615.
; Reference to $$BROKER^XWBLIB is supported by DBIA #2198.
;
ENIVKV ; kill IV variables
K CHK,PSIVPL,PSIVPR,PSIVSITE,PSIVSN,PSIVBR,PSIVENO
;
ENKV ; when exiting package
K PSGP,PSJPAD,PSJPAGE,PSJPBID,PSJPCAF,PSJPDD,PSJPDOB,PSJPDX,PSJPFWD,PSJPHT,PSJPHTD,PSJPPID,PSJPPR,PSJPRB,PSJPSEX,PSJPSSN,PSJPTD,PSJPTS,PSJPTSP,PSJPWD,PSJPWDN,PSJPWT,PSJPWTD,PSJDCEXP
I '$D(PSJNKF) K DFN,VA,VADM,VAERR,VAIN,VAIP
K PSJNKF,%,%DT,%H,%I,%T,%X,%Y,%ZIS,D,D0,D1,D2,DA,DI,DIC,DICR,DIE,DIG,DIH,DIK,DIR,DIRUT,DIQ,DISYS,DIU,DIV,DIW,DLAYGO,DP,DR,DQ,DTOUT,DUOUT,DZ,IO("Q"),IOP,POP,X,X1,X2,Y,XX,ZTSK
K PSGDT,PSGID,PSGION,PSGOD,Q,QQ,PSJSYSL,PSJSYSW0,PSJSYSW,PSJSYSP,PSJSYSP0,PSJSYSU,PSJOCNT,PSJRNF,PSJIRNF,PSJITECH,PSGPXDEV,PSGDDI,PSJORPVN,PSJPN
Q
;
ENCV ; check for (and set) package variables
K %DT,%ZIS,DIC,IOP D ^%ZISC,HOME^%ZIS
I '$D(ZTQUEUED),'$D(VALMWD) D
.S X="XWBLIB" X ^%ZOSF("TEST") I $T,($$BROKER^XWBLIB) Q
.D TERM^VALM0
D NOW^%DTC S PSGDT=+$E(%,1,12)
I $D(^TMP("PSJUSER",$J,"PSG",0)),$D(^(1)),$D(PSJSYSU) D K %,%H,%I,X Q
.; naked ref below is from line above
.S %=^(0),PSJSYSU=$P(%,"^"),PSJSYSP=$P(%,"^",2),PSJSYSP0=^(1),PSJSYSL=$P(PSJSYSP0,"^",7)]""_"^"_$P(PSJSYSP0,"^",7),%=$G(^VA(200,DUZ,"PS")),$P(PSJSYSU,";",2)=$S('%:"",'$P(%,"^",4):1,1:$P(%,"^",4)\1>DT)
.I 'PSJSYSL,$G(PSJSYSW0) D SYSL
S PSJSYSU="",%=$G(^VA(200,DUZ,"PS")) I %,$S('$P(%,"^",4):1,1:$P(%,"^",4)>DT) S $P(PSJSYSU,";",2)=1
I $D(^XUSEC("PSJ RNURSE",DUZ)) D
.S:$D(^XUSEC("PSJ RNFINISH",DUZ)) PSJRNF=1
.S:$D(^XUSEC("PSJI RNFINISH",DUZ)) PSJIRNF=1
S:$D(^XUSEC("PSJI PHARM TECH",DUZ)) PSJITECH=1
S DIC="^PS(53.45,",DIC(0)="LNZ",DLAYGO=53.45,(DINUM,X)="`"_+DUZ D ^DIC
S PSJSYSP=+Y,PSJSYSP0=Y(0) F X=3,1,2 I $D(^XUSEC("PSJ "_$P("RNURSE^PHARM TECH^RPHARM","^",X),DUZ)) S $P(PSJSYSU,";",3)=X Q
I $P(PSJSYSU,";",3),"13"[$P(PSJSYSU,";",3) S $P(PSJSYSU,";")=$P(PSJSYSU,";",3)
S $P(PSJSYSU,";",4)=+PSJSYSU=3!$P(PSJSYSP0,"^",2)!$D(^XUSEC("PSJ RNFINISH",DUZ)),PSJSYSL=$P(PSJSYSP0,"^",7)]""_"^"_$P(PSJSYSP0,"^",7)
I 'PSJSYSL,$G(PSJSYSW0) D SYSL
I PSJSYSU S $P(PSJSYSP0,"^",3)=1,$P(PSJSYSP0,"^",4)=1,$P(PSJSYSP0,"^",5)=1
S ^TMP("PSJUSER",$J,"PSG",0)=PSJSYSU_"^"_PSJSYSP,^(1)=PSJSYSP0 K %,%H,%I,DA,DIC,DLAYGO,X,Y Q
;
ENDTC(Y) ; convert FM internal date/time to user readable format
I Y S Y=Y_$E(".",Y'[".")_"0000",Y=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)_" "_$E(Y,9,10)_":"_$E(Y,11,12)
E S Y="********"
Q Y
;
SYSL ;
Q:$G(PSJSYSL)!'$G(PSJSYSW0)
S X=$P($G(PSJSYSU),";",3)>1 S PSJSYSL=$S(X=0:$P(PSJSYSW0,"^",12),1:$P(PSJSYSW0,"^",16)) I PSJSYSL D
.S:X X='$P(PSJSYSP0,"^",10) S IOP=$S($P(PSJSYSP0,"^",13)]"":$P(PSJSYSP0,"^",13),$P(PSJSYSW0,"^",19+X)]"":$P(PSJSYSW0,"^",19+X),1:"") I IOP]"" D
..S IOP="`"_IOP K %ZIS S %ZIS="NQ" D ^%ZIS S:'POP $P(PSJSYSL,"^",2,3)=ION_"^"_IO D HOME^%ZIS
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGSETU 3004 printed Dec 13, 2024@02:03:11 Page 2
PSGSETU ;BIR/CML3-PACKAGE UTILITIES ;10 Mar 99 / 10:53 AM
+1 ;;5.0; INPATIENT MEDICATIONS ;**3,11,26,39,58,115,133,181**;16 DEC 97;Build 190
+2 ;
+3 ; Reference to TERM^VALM0 is supported by DBIA #2615.
+4 ; Reference to $$BROKER^XWBLIB is supported by DBIA #2198.
+5 ;
ENIVKV ; kill IV variables
+1 KILL CHK,PSIVPL,PSIVPR,PSIVSITE,PSIVSN,PSIVBR,PSIVENO
+2 ;
ENKV ; when exiting package
+1 KILL PSGP,PSJPAD,PSJPAGE,PSJPBID,PSJPCAF,PSJPDD,PSJPDOB,PSJPDX,PSJPFWD,PSJPHT,PSJPHTD,PSJPPID,PSJPPR,PSJPRB,PSJPSEX,PSJPSSN,PSJPTD,PSJPTS,PSJPTSP,PSJPWD,PSJPWDN,PSJPWT,PSJPWTD,PSJDCEXP
+2 IF '$DATA(PSJNKF)
KILL DFN,VA,VADM,VAERR,VAIN,VAIP
+3 KILL PSJNKF,%,%DT,%H,%I,%T,%X,%Y,%ZIS,D,D0,D1,D2,DA,DI,DIC,DICR,DIE,DIG,DIH,DIK,DIR,DIRUT,DIQ,DISYS,DIU,DIV,DIW,DLAYGO,DP,DR,DQ,DTOUT,DUOUT,DZ,IO("Q"),IOP,POP,X,X1,X2,Y,XX,ZTSK
+4 KILL PSGDT,PSGID,PSGION,PSGOD,Q,QQ,PSJSYSL,PSJSYSW0,PSJSYSW,PSJSYSP,PSJSYSP0,PSJSYSU,PSJOCNT,PSJRNF,PSJIRNF,PSJITECH,PSGPXDEV,PSGDDI,PSJORPVN,PSJPN
+5 QUIT
+6 ;
ENCV ; check for (and set) package variables
+1 KILL %DT,%ZIS,DIC,IOP
DO ^%ZISC
DO HOME^%ZIS
+2 IF '$DATA(ZTQUEUED)
IF '$DATA(VALMWD)
Begin DoDot:1
+3 SET X="XWBLIB"
XECUTE ^%ZOSF("TEST")
IF $TEST
IF ($$BROKER^XWBLIB)
QUIT
+4 DO TERM^VALM0
End DoDot:1
+5 DO NOW^%DTC
SET PSGDT=+$EXTRACT(%,1,12)
+6 IF $DATA(^TMP("PSJUSER",$JOB,"PSG",0))
IF $DATA(^(1))
IF $DATA(PSJSYSU)
Begin DoDot:1
+7 ; naked ref below is from line above
+8 SET %=^(0)
SET PSJSYSU=$PIECE(%,"^")
SET PSJSYSP=$PIECE(%,"^",2)
SET PSJSYSP0=^(1)
SET PSJSYSL=$PIECE(PSJSYSP0,"^",7)]""_"^"_$PIECE(PSJSYSP0,"^",7)
SET %=$GET(^VA(200,DUZ,"PS"))
SET $PIECE(PSJSYSU,";",2)=$SELECT('%:"",'$PIECE(%,"^",4):1,1:$PIECE(%,"^",4)\1>DT)
+9 IF 'PSJSYSL
IF $GET(PSJSYSW0)
DO SYSL
End DoDot:1
KILL %,%H,%I,X
QUIT
+10 SET PSJSYSU=""
SET %=$GET(^VA(200,DUZ,"PS"))
IF %
IF $SELECT('$PIECE(%,"^",4):1,1:$PIECE(%,"^",4)>DT)
SET $PIECE(PSJSYSU,";",2)=1
+11 IF $DATA(^XUSEC("PSJ RNURSE",DUZ))
Begin DoDot:1
+12 if $DATA(^XUSEC("PSJ RNFINISH",DUZ))
SET PSJRNF=1
+13 if $DATA(^XUSEC("PSJI RNFINISH",DUZ))
SET PSJIRNF=1
End DoDot:1
+14 if $DATA(^XUSEC("PSJI PHARM TECH",DUZ))
SET PSJITECH=1
+15 SET DIC="^PS(53.45,"
SET DIC(0)="LNZ"
SET DLAYGO=53.45
SET (DINUM,X)="`"_+DUZ
DO ^DIC
+16 SET PSJSYSP=+Y
SET PSJSYSP0=Y(0)
FOR X=3,1,2
IF $DATA(^XUSEC("PSJ "_$PIECE("RNURSE^PHARM TECH^RPHARM","^",X),DUZ))
SET $PIECE(PSJSYSU,";",3)=X
QUIT
+17 IF $PIECE(PSJSYSU,";",3)
IF "13"[$PIECE(PSJSYSU,";",3)
SET $PIECE(PSJSYSU,";")=$PIECE(PSJSYSU,";",3)
+18 SET $PIECE(PSJSYSU,";",4)=+PSJSYSU=3!$PIECE(PSJSYSP0,"^",2)!$DATA(^XUSEC("PSJ RNFINISH",DUZ))
SET PSJSYSL=$PIECE(PSJSYSP0,"^",7)]""_"^"_$PIECE(PSJSYSP0,"^",7)
+19 IF 'PSJSYSL
IF $GET(PSJSYSW0)
DO SYSL
+20 IF PSJSYSU
SET $PIECE(PSJSYSP0,"^",3)=1
SET $PIECE(PSJSYSP0,"^",4)=1
SET $PIECE(PSJSYSP0,"^",5)=1
+21 SET ^TMP("PSJUSER",$JOB,"PSG",0)=PSJSYSU_"^"_PSJSYSP
SET ^(1)=PSJSYSP0
KILL %,%H,%I,DA,DIC,DLAYGO,X,Y
QUIT
+22 ;
ENDTC(Y) ; convert FM internal date/time to user readable format
+1 IF Y
SET Y=Y_$EXTRACT(".",Y'[".")_"0000"
SET Y=$EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_"/"_$EXTRACT(Y,2,3)_" "_$EXTRACT(Y,9,10)_":"_$EXTRACT(Y,11,12)
+2 IF '$TEST
SET Y="********"
+3 QUIT Y
+4 ;
SYSL ;
+1 if $GET(PSJSYSL)!'$GET(PSJSYSW0)
QUIT
+2 SET X=$PIECE($GET(PSJSYSU),";",3)>1
SET PSJSYSL=$SELECT(X=0:$PIECE(PSJSYSW0,"^",12),1:$PIECE(PSJSYSW0,"^",16))
IF PSJSYSL
Begin DoDot:1
+3 if X
SET X='$PIECE(PSJSYSP0,"^",10)
SET IOP=$SELECT($PIECE(PSJSYSP0,"^",13)]"":$PIECE(PSJSYSP0,"^",13),$PIECE(PSJSYSW0,"^",19+X)]"":$PIECE(PSJSYSW0,"^",19+X),1:"")
IF IOP]""
Begin DoDot:2
+4 SET IOP="`"_IOP
KILL %ZIS
SET %ZIS="NQ"
DO ^%ZIS
if 'POP
SET $PIECE(PSJSYSL,"^",2,3)=ION_"^"_IO
DO HOME^%ZIS
End DoDot:2
End DoDot:1
+5 QUIT
