- PSGPER ;BIR/CML3-PRINTS PRE-EXCHANGE NEEDS REPORT ;04 JAN 95 / 5:08 PM
- ;;5.0; INPATIENT MEDICATIONS ;**95,115,127,133**;16 DEC 97
- ;
- S PSGPERRF=0
- DEV ;
- S PSGION=ION
- DEV1 ;
- Q:'$$DEFON^PSGPER1
- S D=$G(PSGPXDEV) S:'D D=$P(PSJSYSW0,U,29) 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"),ION S %ZIS="QM",%ZIS("A")="Select DEVICE for PRE-EXCHANGE UNITS REPORT: ",%ZIS("B")=D D ^%ZIS K %ZIS
- I POP D POP G:%=1 DEV1 G DONE
- I $G(ION)]"",D'=ION D CURDEF
- I $D(IO("Q")) K ZTSAVE S PSGTIR="^PSGPER0",ZTDESC="PRE-EXCHANGE UNITS REPORT",ZTDTH=$H,ZTSAVE("PSGPXN")="" D ENTSK^PSGTI G:'$D(ZTSK) DEV K ZTSK G OUT
- D ENP^PSGPER0:'$G(PSGPXPT),ENPAT^PSGPER0:$G(PSGPXPT),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)
- N PSJSYSW0,PSGVBW,PSJPWD,PSJSYSL D Q
- . D:'$G(PSGPXPT) ENIVKV^PSGSETU
- ;
- 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 %=2 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
- 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 S D=+$G(Y)
- 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 $P(PSJSYSW0,"^",29)=+Y
- K DIC,DR,DA,X,Y,DIE
- Q
- ;
- 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."
- Q
- PSGPER ;BIR/CML3-PRINTS PRE-EXCHANGE NEEDS REPORT ;04 JAN 95 / 5:08 PM
- +1 ;;5.0; INPATIENT MEDICATIONS ;**95,115,127,133**;16 DEC 97
- +2 ;
- +3 SET PSGPERRF=0
- DEV ;
- +1 SET PSGION=ION
- DEV1 ;
- +1 IF '$$DEFON^PSGPER1
- QUIT
- +2 SET D=$GET(PSGPXDEV)
- IF 'D
- SET D=$PIECE(PSJSYSW0,U,29)
- IF D=""
- SET D="HOME"
- SET IOP=$SELECT(D:"`"_D,1:D)
- KILL %ZIS
- SET %ZIS="NQ"
- DO ^%ZIS
- SET D=$GET(ION)
- +3 KILL IOP,%ZIS,IO("Q"),ION
- SET %ZIS="QM"
- SET %ZIS("A")="Select DEVICE for PRE-EXCHANGE UNITS REPORT: "
- SET %ZIS("B")=D
- DO ^%ZIS
- KILL %ZIS
- +4 IF POP
- DO POP
- IF %=1
- GOTO DEV1
- GOTO DONE
- +5 IF $GET(ION)]""
- IF D'=ION
- DO CURDEF
- +6 IF $DATA(IO("Q"))
- KILL ZTSAVE
- SET PSGTIR="^PSGPER0"
- SET ZTDESC="PRE-EXCHANGE UNITS REPORT"
- SET ZTDTH=$HOROLOG
- SET ZTSAVE("PSGPXN")=""
- DO ENTSK^PSGTI
- IF '$DATA(ZTSK)
- GOTO DEV
- KILL ZTSK
- GOTO OUT
- +7 IF '$GET(PSGPXPT)
- DO ENP^PSGPER0
- IF $GET(PSGPXPT)
- DO ENPAT^PSGPER0
- DO AG
- +8 IF %=1
- SET PSGPERRF=1
- GOTO DEV
- +9 ;
- 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 NEW PSJSYSW0,PSGVBW,PSJPWD,PSJSYSL
- Begin DoDot:1
- +4 IF '$GET(PSGPXPT)
- DO ENIVKV^PSGSETU
- End DoDot:1
- 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 %=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
- SET D=+$GET(Y)
- +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)
- SET $PIECE(PSJSYSW0,"^",29)=+Y
- +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
