PSGPER1.m

PSGPER1 ;BIR/CML3-PRINTS PRE-EXCHANGE NEEDS REPORT ;18 MAR 03 / 5:08 PM

 ;;5.0; INPATIENT MEDICATIONS ;**80,127**;16 DEC 97

 ;

 S PSGPERRF=0

DEV ;

 S PSGION=ION

DEV1 K IOP,%ZIS,IO("Q") S %ZIS="Q",%ZIS("A")="Select DEVICE for PRE-EXCHANGE UNITS REPORT: ",%ZIS("B")="" W ! D ^%ZIS K %ZIS

 I POP D POP G:%=1 DEV1 G DONE

 I $D(IO("Q")) K ZTSAVE S PSGTIR="^PSGPER2",ZTDESC="PRE-EXCHANGE UNITS REPORT",ZTDTH=$H,ZTSAVE("PSGPXN")="" D ENTSK^PSGTI G:'$D(ZTSK) DEV K ZTSK G OUT

 D ENP^PSGPER2,AG I %=1 S PSGPERRF=1 G DEV

 ;

DONE ;

 S DIK="^PS(53.4,",DA=PSGPXN D ^DIK

 ;

OUT ;

 K PSGPERRF,PSGPXN

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

 D ENIVKV^PSGSETU,ENCV^PSGSETU

 Q

 ;

POP ;

 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

 Q

 ;

AG ;

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

 Q

 ;

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

 ;

DEFON() ; All Pre-Exchange Devices have been removed from Ward Parameters - restore previous functionality

 N ON,W S ON=0,W=0 F  S W=$O(^PS(59.6,W)) Q:'W!ON  I $P(^(W,0),U,29)]"" S ON=1

 I $G(PSJPXDOF) S ON=0 K PSJPXDOF

 Q ON

PSGPER1   ;BIR/CML3-PRINTS PRE-EXCHANGE NEEDS REPORT ;18 MAR 03 / 5:08 PM

 +1       ;;5.0; INPATIENT MEDICATIONS ;**80,127**;16 DEC 97

 +2       ;

 +3        SET PSGPERRF=0

DEV       ;

 +1        SET PSGION=ION

DEV1       KILL IOP,%ZIS,IO("Q")

           SET %ZIS="Q"

           SET %ZIS("A")="Select DEVICE for PRE-EXCHANGE UNITS REPORT: "

           SET %ZIS("B")=""

           WRITE !

           DO ^%ZIS

           KILL %ZIS

 +1        IF POP

               DO POP

               IF %=1

                   GOTO DEV1

               GOTO DONE

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

               KILL ZTSAVE

               SET PSGTIR="^PSGPER2"

               SET ZTDESC="PRE-EXCHANGE UNITS REPORT"

               SET ZTDTH=$HOROLOG

               SET ZTSAVE("PSGPXN")=""

               DO ENTSK^PSGTI

               IF '$DATA(ZTSK)

                   GOTO DEV

               KILL ZTSK

               GOTO OUT

 +3        DO ENP^PSGPER2

           DO AG

           IF %=1

               SET PSGPERRF=1

               GOTO DEV

 +4       ;

DONE      ;

 +1        SET DIK="^PS(53.4,"

           SET DA=PSGPXN

           DO ^DIK

 +2       ;

OUT       ;

 +1        KILL PSGPERRF,PSGPXN

 +2        IF $GET(PSJCOM)!$GET(PSJPREX)

               QUIT 

 +3        DO ENIVKV^PSGSETU

           DO ENCV^PSGSETU

 +4        QUIT 

 +5       ;

POP       ;

 +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 %=0

               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 

 +3       ;

DEFON()   ; All Pre-Exchange Devices have been removed from Ward Parameters - restore previous functionality

 +1        NEW ON,W

           SET ON=0

           SET W=0

           FOR 

               SET W=$ORDER(^PS(59.6,W))

               IF 'W!ON

                   QUIT 

               IF $PIECE(^(W,0),U,29)]""

                   SET ON=1

 +2        IF $GET(PSJPXDOF)

               SET ON=0

               KILL PSJPXDOF

 +3        QUIT ON