PSGSETU.m

PSGSETU ;BIR/CML3-PACKAGE UTILITIES ;10 Mar 99 / 10:53 AM

 ;;5.0; INPATIENT MEDICATIONS ;**3,11,26,39,58,115,133**;16 DEC 97

 ;

 ; 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

 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

PSGSETU   ;BIR/CML3-PACKAGE UTILITIES ;10 Mar 99 / 10:53 AM

 +1       ;;5.0; INPATIENT MEDICATIONS ;**3,11,26,39,58,115,133**;16 DEC 97

 +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

 +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