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
Q
DEV ; Select Device
S PSGION=ION
D DEV1
Q
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
Q
;
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
Q
;
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
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,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
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGPER 3206 printed Dec 13, 2024@02:02:39 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
