- 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
