Routine: PSGPER

PSGPER ;BIR/CML3-PRINTS PRE-EXCHANGE NEEDS REPORT ;04 JAN 95 / 5:08 PM

 ;;5.0;INPATIENT MEDICATIONS;**95,115,127,133,279**;16 DEC 97;Build 150

EN ; Entry point

 S PSGPERRF=0,POP=0 N PSGPRCLD,PSGCURCL S PSGPRCLD="" D DEFCL^PSGPER1(PSGPXN,.PSGPRCLD)

 N PSGPRTYP,PSGPRCL

 I $G(PSGPRCLD("WARD")) S PSGPRTYP="PSGPERP" D DEV K PSGPRCLD("WARD")

 I POP D POP G:%=1 EN D OUT Q

 I $D(PSGPRCLD)>1 S PSGPRTYP="PSGPERPC" S PSGCURCL="" F  S PSGCURCL=$O(PSGPRCLD("DEV",PSGCURCL)) Q:PSGCURCL=""  D DEV

 D OUT

DEV ; Select Device

 S PSGION=ION

 D DEV1

DEV1 ; Get default device, select and validate device

 Q:'$$DEFON^PSGPER1

 W !!,"PRE-EXCHANGE UNITS REPORT"

 I ($G(PSGCURCL)="") S D=$S($G(PSGPXDEV):PSGPXDEV,1:$P(PSJSYSW0,U,29))

 I $L($G(PSGCURCL)) S D=$G(PSGPRCLD("DEV",PSGCURCL))

 S:D="" D="HOME" S IOP=$S(D:"`"_D,1:D) K %ZIS S %ZIS="NQ" D ^%ZIS S D=$G(ION)

 K IOP,%ZIS,IO("Q") S %ZIS="Q",%ZIS("A")="Select DEVICE for "_$S($G(PSGPRCLD("WARD")):"Ward "_$G(^DPT(DFN,.1)),$G(PSGCURCL)]"":"Clinic "_PSGCURCL,1:"")_": ",%ZIS("B")=$S(($G(PSGCURCL)]""):$G(PSGPRCLD("DEV",PSGCURCL)),1:D)

 D ^%ZIS K %ZIS I POP D POP G:%=1 DEV1

 I D'=$G(ION) D CURDEF

 I $D(IO("Q")) K ZTSAVE S PSGTIR="^PSGPER0",ZTDESC="PRE-EXCHANGE UNITS REPORT",ZTDTH=$H,ZTSAVE("PSGPXN")="",ZTSAVE("PSGPRTYP")="",ZTSAVE("PSGCURCL")="",ZTSAVE("DFN")="" D ENTSK^PSGTI G:'$D(ZTSK) DEV1 K ZTSK Q

 D ENP^PSGPER0:'$G(PSGPXPT),ENPAT^PSGPER0:$G(PSGPXPT),AG

 I %=1 S PSGPERRF=1 G DEV1

OUT ; Clean up on the way out

 D TASKPRGE^PSGPER1(PSGPXN)

 K PSGPERRF,PSGPXN

 Q:$G(PSJCOM)!$G(PSJPREX)

 N PSJSYSW0,PSGVBW,PSJPWD,PSJSYSL D  Q

 . D:'$G(PSGPXPT) ENIVKV^PSGSETU

POP ; Abort?

 S %=2 W:'PSGPERRF !!,"IF A DEVICE IS NOT CHOSEN, NO REPORT WILL BE RUN AND THE DATA WILL NO LONGER BE RETRIEVABLE THROUGH THIS REPORT."

 I 'PSGPERRF F  W !,"Do you want another chance to choose a device" S %=1 D YN^DICN Q:%  W !?3,"Enter 'YES' to choose a device to print.  Enter 'NO' to quit now."

 I %'=1 S IOP=PSGION D ^%ZIS S %=2

AG ;

 F  W !!,"DO YOU NEED TO PRINT THIS REPORT AGAIN" S %=2 D YN^DICN Q:%  D AGMSG

AGMSG ;

 I %Y'?1."?" W $C(7),"  ANSWER 'YES' OR 'NO' (Entry required)" Q

 W !,"  Enter 'YES' to print this report again.  Enter 'NO' (or an '^') to quit",!,"now.  PLEASE NOTE that you will NOT be able to retrieve this data at a later",!,"date.  You should print this information now." Q

CURDEF ;

 Q:$G(PSGPXDEV)=0

 K DIC,DR,DA,X,Y,DIE S DIC="^%ZIS(1,",DIC(0)="SOX",X=ION D ^DIC Q:'($G(Y)>0)

 N D,DN S D=+$G(Y),DN=$P($G(Y),"^",2)

 F  W !!,"Keep ",ION," as the PRE-EXCHANGE REPORT DEVICE for this session" S %=0 D YN^DICN S PSGPXDEV=$S(%=1:D,1:0) Q:%  D DEFMSG

 I $G(Y) S:($G(PSGCURCL)="") $P(PSJSYSW0,"^",29)=+Y I ($G(PSGCURCL)]"") N CLIEN S CLIEN=$O(^SC("B",PSGCURCL,"")) I CLIEN S $P(PSJSYSW0("CLINIC",CLIEN,1),"^")=D,PSGPRCLD("DEV",PSGCURCL)=DN

 K DIC,DR,DA,X,Y,DIE

DEFMSG ;

 I %Y'?1."?" W !,$C(7),"     ANSWER 'YES' OR 'NO' (Entry required)" Q

 W !!,"  Enter 'YES' to make ",ION," the PRE-EXCHANGE REPORT default DEVICE"

 W !,"  for the current session. PLEASE NOTE that this will override the ward"

 W !,"  default PRE-EXCHANGE REPORT DEVICE for this session only."

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGPER   3206     printed  Feb 18, 2025@23:29:03                                                                                                                                                                                                      Page 2

PSGPER    ;BIR/CML3-PRINTS PRE-EXCHANGE NEEDS REPORT ;04 JAN 95 / 5:08 PM

 +1       ;;5.0;INPATIENT MEDICATIONS;**95,115,127,133,279**;16 DEC 97;Build 150

 +2       ;

EN        ; Entry point

 +1        SET PSGPERRF=0

           SET POP=0

           NEW PSGPRCLD,PSGCURCL

           SET PSGPRCLD=""

           DO DEFCL^PSGPER1(PSGPXN,.PSGPRCLD)

 +2        NEW PSGPRTYP,PSGPRCL

 +3        IF $GET(PSGPRCLD("WARD"))

               SET PSGPRTYP="PSGPERP"

               DO DEV

               KILL PSGPRCLD("WARD")

 +4        IF POP

               DO POP

               if %=1

                   GOTO EN

               DO OUT

               QUIT

 +5        IF $DATA(PSGPRCLD)>1

               SET PSGPRTYP="PSGPERPC"

               SET PSGCURCL=""

FOR

                   SET PSGCURCL=$ORDER(PSGPRCLD("DEV",PSGCURCL))

                   if PSGCURCL=""

                       QUIT

                   DO DEV

 +6        DO OUT

 +7        QUIT

DEV       ; Select Device

 +1        SET PSGION=ION

 +2        DO DEV1

 +3        QUIT

DEV1      ; Get default device, select and validate device

 +1        if '$$DEFON^PSGPER1

               QUIT

 +2        WRITE !!,"PRE-EXCHANGE UNITS REPORT"

 +3        IF ($GET(PSGCURCL)="")

               SET D=$SELECT($GET(PSGPXDEV):PSGPXDEV,1:$PIECE(PSJSYSW0,U,29))

 +4        IF $LENGTH($GET(PSGCURCL))

               SET D=$GET(PSGPRCLD("DEV",PSGCURCL))

 +5        if D=""

               SET D="HOME"

           SET IOP=$SELECT(D:"`"_D,1:D)

           KILL %ZIS

           SET %ZIS="NQ"

           DO ^%ZIS

           SET D=$GET(ION)

 +6        KILL IOP,%ZIS,IO("Q")

           SET %ZIS="Q"

           SET %ZIS("A")="Select DEVICE for "_$SELECT($GET(PSGPRCLD("WARD")):"Ward "_$GET(^DPT(DFN,.1)),$GET(PSGCURCL)]"":"Clinic "_PSGCURCL,1:"")_": "

           SET %ZIS("B")=$SELECT(($GET(PSGCURCL)]""):$GET(PSGPRCLD("DEV",PSGCURCL)),1:D)

 +7        DO ^%ZIS

           KILL %ZIS

           IF POP

               DO POP

               if %=1

                   GOTO DEV1

 +8        IF D'=$GET(ION)

               DO CURDEF

 +9        IF $DATA(IO("Q"))

               KILL ZTSAVE

               SET PSGTIR="^PSGPER0"

               SET ZTDESC="PRE-EXCHANGE UNITS REPORT"

               SET ZTDTH=$HOROLOG

               SET ZTSAVE("PSGPXN")=""

               SET ZTSAVE("PSGPRTYP")=""

               SET ZTSAVE("PSGCURCL")=""

               SET ZTSAVE("DFN")=""

               DO ENTSK^PSGTI

               if '$DATA(ZTSK)

                   GOTO DEV1

               KILL ZTSK

               QUIT

 +10       if '$GET(PSGPXPT)

               DO ENP^PSGPER0

           if $GET(PSGPXPT)

               DO ENPAT^PSGPER0

           DO AG

 +11       IF %=1

               SET PSGPERRF=1

               GOTO DEV1

 +12       QUIT

 +13      ;

OUT       ; Clean up on the way out

 +1        DO TASKPRGE^PSGPER1(PSGPXN)

 +2        KILL PSGPERRF,PSGPXN

 +3        if $GET(PSJCOM)!$GET(PSJPREX)

               QUIT

 +4        NEW PSJSYSW0,PSGVBW,PSJPWD,PSJSYSL

           Begin DoDot:1

 +5            if '$GET(PSGPXPT)

                   DO ENIVKV^PSGSETU

           End DoDot:1

           QUIT

 +6        QUIT

 +7       ;

POP       ; Abort?

 +1        SET %=2

           if 'PSGPERRF

               WRITE !!,"IF A DEVICE IS NOT CHOSEN, NO REPORT WILL BE RUN AND THE DATA WILL NO LONGER BE RETRIEVABLE THROUGH THIS REPORT."

 +2        IF 'PSGPERRF

FOR

                   WRITE !,"Do you want another chance to choose a device"

                   SET %=1

                   DO YN^DICN

                   if %

                       QUIT

                   WRITE !?3,"Enter 'YES' to choose a device to print.  Enter 'NO' to quit now."

 +3        IF %'=1

               SET IOP=PSGION

               DO ^%ZIS

               SET %=2

 +4        QUIT

 +5       ;

AG        ;

 +1        FOR

               WRITE !!,"DO YOU NEED TO PRINT THIS REPORT AGAIN"

               SET %=2

               DO YN^DICN

               if %

                   QUIT

               DO AGMSG

 +2        QUIT

 +3       ;

AGMSG     ;

 +1        IF %Y'?1."?"

               WRITE $CHAR(7),"  ANSWER 'YES' OR 'NO' (Entry required)"

               QUIT

 +2        WRITE !,"  Enter 'YES' to print this report again.  Enter 'NO' (or an '^') to quit",!,"now.  PLEASE NOTE that you will NOT be able to retrieve this data at a later",!,"date.  You should print this information now."

           QUIT

CURDEF    ;

 +1        if $GET(PSGPXDEV)=0

               QUIT

 +2        KILL DIC,DR,DA,X,Y,DIE

           SET DIC="^%ZIS(1,"

           SET DIC(0)="SOX"

           SET X=ION

           DO ^DIC

           if '($GET(Y)>0)

               QUIT

 +3        NEW D,DN

           SET D=+$GET(Y)

           SET DN=$PIECE($GET(Y),"^",2)

 +4        FOR

               WRITE !!,"Keep ",ION," as the PRE-EXCHANGE REPORT DEVICE for this session"

               SET %=0

               DO YN^DICN

               SET PSGPXDEV=$SELECT(%=1:D,1:0)

               if %

                   QUIT

               DO DEFMSG

 +5        IF $GET(Y)

               if ($GET(PSGCURCL)="")

                   SET $PIECE(PSJSYSW0,"^",29)=+Y

               IF ($GET(PSGCURCL)]"")

                   NEW CLIEN

                   SET CLIEN=$ORDER(^SC("B",PSGCURCL,""))

                   IF CLIEN

                       SET $PIECE(PSJSYSW0("CLINIC",CLIEN,1),"^")=D

                       SET PSGPRCLD("DEV",PSGCURCL)=DN

 +6        KILL DIC,DR,DA,X,Y,DIE

 +7        QUIT

 +8       ;

DEFMSG    ;

 +1        IF %Y'?1."?"

               WRITE !,$CHAR(7),"     ANSWER 'YES' OR 'NO' (Entry required)"

               QUIT

 +2        WRITE !!,"  Enter 'YES' to make ",ION," the PRE-EXCHANGE REPORT default DEVICE"

 +3        WRITE !,"  for the current session. PLEASE NOTE that this will override the ward"

 +4        WRITE !,"  default PRE-EXCHANGE REPORT DEVICE for this session only."

 +5        QUIT

PSGPER.m