PSGMAR ;BIR/CML3-24 HOUR MAR - MAIN DRIVER ;14 Oct 98 / 4:27 PM
;;5.0; INPATIENT MEDICATIONS ;**8,15,20,111,131,145**;16 DEC 97;Build 17
;
EN ;
;
NEW PSGOP
D ENCV^PSGSETU G:$D(XQUIT) DONE
D MARFORM^PSGMUTL G:PSGMARB=0 DONE S:PSGMARB'=1 PSGMARS=3
G:PSGMARB'=1 ENDATE F R !!,"Print (C)ontinuous sheets, (P)RN sheets, or (B)oth? B// ",X:DTIME W:'$T $C(7) S:'$T X="^" Q:"^CPB"[X&($L(X)<2) W:X'?1."?" $C(7)," ??" D:X?1."?" SHTH
G:X="^" DONE I X="" W " (Both)" S PSGMARS=3
E W $S(X="C":"ontinuous",X="P":"RN",1:"oth") S PSGMARS=$F("CPB",X)-1
;
ENDATE ; get start date
S %DT="ETX",Y=-1 F W !!,"Enter START DATE/TIME for 24 hour MAR: " R X:DTIME W:'$T $C(7) S:'$T X="^" Q:"^"[X D:X?1."?" DH D ^%DT Q:Y>0
I Y'>0 W $C(7),!!?5,"(No date selected for MAR run.)" G DONE
S PSGMARDT=+$E(Y,1,10) D:$P(PSGMARDT,".",2)
.S PSGPLS=PSGMARDT,PSGPLF=$$EN^PSGCT(PSGPLS,-1),ST=$P(PSGPLS_0,".",2),FT=$P(PSGPLF_0,".",2)
.S PSGMARSD=$E(ST,1,2),PSGMARFD=$E(FT,1,2) S:'PSGMARSD PSGMARSD="01" S PSGMARFD=$S(+PSGMARSD=1:24,PSGMARSD=PSGMARFD:PSGMARSD-1,1:PSGMARFD) S:$L(PSGMARFD)<2 PSGMARFD=0_PSGMARFD
.I ST>1 S X1=$P(PSGPLF,"."),X2=1 D C^%DTC S PSGPLF=X
.S PSGPLS=+(PSGPLS_"."_ST),PSGPLF=+(PSGPLF_"."_FT)
.S PSGMARSP=$$ENDTC2^PSGMI(PSGPLS),PSGMARFP=$$ENDTC2^PSGMI(PSGPLF)
D NOW^%DTC S PSGDT=%,(PSGMARWG,PSJPWDO)=0,PSGMARWD=+$G(PSJPWD),PSGRBPPN=""
I '$D(PSGOENOF) S (PSGP,PSGPAT)=0,PSGSSH="MAR" D ^PSGSEL G:"^"[PSGSS OUT D @PSGSS G:$G(PSJSTOP) OUT
G:$$MEDTYPE^PSJMDIR(PSGMARWD) OUT S PSGMTYPE=Y
D DEV I POP!$D(IO("Q")) G DONE
;
ENQ ; when queued
N F,P,DRGI,DRGN,DRGT,PSIVUP,PSJORIFN,PSGMSORT
S PSJACNWP=1 U IO D ^PSGMAR0 I $D(^TMP($J))>9 D ^PSGMAR1
;DAM 5-01-07
I $D(PSGREP) K ^XTMP(PSGREP)
;END DAM
D ^%ZISC G DONE
;
OUT W $C(7),!!?5,"(No patient(s) selected for MAR run.)" K PSGPLF,PSGPLS
DONE ;
I '$D(PSGOENOF) D ENKV^PSGSETU
K AD,ASTERS,BD,BLN,C,CNTR,DA1,DA2,DAO,DFN,DRG,DX,EXPIRE,FD,FT,HX,L,LN1,LN14,LN2,LN3,LN4,LN5,LN6,LN7,MOS,MSG1,MSG2,ND2,NG,OPST,PSJJORD,PAGE,PN,PND,PNN,PPN,PRB,PSEX,PSSN,PSGPLF,PSGPLS,PSGPLC,PSGPLO,QX,TMSTR,XX
K PSGADR,PSGALG,PSGD,PSGDW,PSGFORM,PSGMAR,PSGMARB,PSGMARDF,PSGMARDT,PSGMARED,PSGMARGD,PSGMARFD,PSGMARFP,PSGMAROC,PSGMARS,PSGMARSD,PSGL
K PSGMARSM,PSGMARSP,PSGMARTS,PSGMARWD,PSGMARWG,PSGMARWN,PSGMARWS,PSGMPG,PSGMPGN,PSGORD,PSGPAT,PSJDIET
K PSJSTOP,PSJPWDO,PSGMARO,ST,PSGSS,PSGSSH,PSTXDT,PST,PTM,PWDN,PSJACNWP,QST,R,RB,RCT,S,SD,SM,SPACES,TM,T,TD,TS,WD,WDN,WG,WGN,WS,WT,X1,X2,Y1,^TMP($J)
K PSGST,PSGTM,PSGTMALL,XTYPE,PSGLRPH,PSGMTYPE,PSGPG,PSGMFOR,PSGMTYPE,PSGPG,PSGRBPPN,PSGS0XT,PSGS0Y
K HT,ON,PSGOENOF,PSGOES,PSGRBPPN,PSGS0XT,PSGST,PSGTIR,PSGWD,XQUIT,ZTDES,ONHOLD
D ENKV^PSGLOI
Q
;
G ; get ward group
S DIC="^PS(57.5,",DIC(0)="QEAMI",DIC("A")="Select WARD GROUP: " W ! D ^DIC K DIC D I $G(PSJSTOP)=1 Q
. I X="^OTHER" S PSGMARWG="^OTHER" Q
. S PSGMARWG=+Y
. I +Y'>0 S PSJSTOP=1
D RBPPN^PSJMDIR
Q
;
W ; get ward
S DIC="^DIC(42,",DIC(0)="QEAMI",DIC("A")="Select WARD: " W ! D ^DIC K DIC S PSGMARWD=+Y I +Y'>0 S PSJSTOP=1 Q
S PSGWD=PSGMARWD D ADMTM^PSJMDIR
D:'PSJSTOP RBPPN^PSJMDIR
Q
;
P ; get patient
K PSGPAT S PSGPAT=0 F CNTR=0:1 S:CNTR PSGDICA="another" D ENP^PSGGAO:'PSGMARB,ENDPT^PSGP:PSGMARB Q:PSGP'>0 D
. S PSGPAT(PSGP)="",PSGPAT=PSGP
. ;*** PSGMARWD=1 when all patients are select from the same ward.
. S:'$G(PSJPWDO) (PSGMARWD,PSJPWDO)=PSJPWD S PSGMARWD=$S('$G(PSGMARWD):0,PSJPWDO=PSJPWD:PSJPWD,1:0)
S Y=PSGPAT S:Y'>0 PSJSTOP=1 K PSGDICA
Q
;
C ;
;DAM Add new variable to hold numerical value of CLINIC 5-01-07
S PSGCLNC=""
K DIR S DIR(0)="FAO",DIR("A")="Select CLINIC: "
S DIR("?")="^D CDIC^PSGVBW" W ! D ^DIR
CDIC ;
K DIC S DIC="^SC(",DIC(0)="QEMIZ" D ^DIC K DIC S:+Y>0 CL=+Y S PSGCLNC=+Y I +Y<0 S PSJSTOP=1 Q
W:X["?" !!,"Enter the clinic you want to use to select patients for processing.",!
Q
L ;
K DIR S DIR(0)="FAO",DIR("A")="Select CLINIC GROUP: "
S DIR("?")="^D LDIC^PSGVBW" W ! D ^DIR
LDIC ;
K DIC S DIC="^PS(57.8,",DIC(0)="QEMI" D ^DIC K DIC S:+Y>0 CG=+Y I +Y<0 S PSJSTOP=1 Q
W:X["?" !!,"Enter the name of the clinic group you want to use to select patients for processing."
Q
DEV ; ask print device and queue if asked to
K ZTSAVE S PSGTIR="ENQ^PSGMAR",ZTDESC="24 HOUR MAR" S:PSGMARB ZTSAVE("PSGMARS")="" D
. F X="PSGMARWG","PSGMARWD","PSGP","PSGPAT(","PSGDT","PSGMARDT","PSGSS","PSGMARB","PSGMARDF","PSGMTYPE","PSGRBPPN","^TMP($J,","PSGINCL","PSGINCLG","PSGINWD","PSGINWDG" S ZTSAVE(X)=""
I $P(PSGMARDT,".",2) F X="PSGPLS","PSGPLF","PSGMARSD","PSGMARFD","PSGMARSP","PSGMARFP" S ZTSAVE(X)=""
I PSGSS="W" F X="PSGTMALL","PSGTM","PSGTM(" S ZTSAVE(X)=""
D ENDEV^PSGTI W:POP !!?3,"No device selected for 24 hour MAR run." W:$D(ZTSK) !?3,"24 hour MAR Queued!" K ZTSK Q
I 'IO("Q") U IO
;
BH ;
W !!," Enter a 'Y' to print BLANK (no data) MARs for the patient(s) you select.",!,"Enter an 'N' (or press the RETURN key) to print MARs complete with orders.",!,"Enter an '^' to exit this option now." Q
;
DH ;
W !!?2,"Enter the START DATE of the 24 hour period for which this MAR is to print.",!,"Unless the BLANK MARs are selected, all orders for the patient(s) selected that",!,"are (or were) active during the date range selected will print."
W !?2,"Time is not required. If time is not entered, the default time is used (if",!,"found in the site parameters). If the default time is not found, the start of",!,"the day is used." Q
;
SHTH ;
W !!?2,"Enter 'C' to print ONLY CONTINUOUS blank sheets for the patients selected.",!,"Enter 'P' to print ONLY PRN sheets. Enter 'B' (or press RETURN) to print BOTH",!,"sheets for each patient." Q
;
ENLM ;
S PSGOENOF=1,PSGPAT(PSGP)="",PSGSS="P" G EN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGMAR 5703 printed Apr 09, 2024@21:09:17 Page 2
PSGMAR ;BIR/CML3-24 HOUR MAR - MAIN DRIVER ;14 Oct 98 / 4:27 PM
+1 ;;5.0; INPATIENT MEDICATIONS ;**8,15,20,111,131,145**;16 DEC 97;Build 17
+2 ;
EN ;
+1 ;
+2 NEW PSGOP
+3 DO ENCV^PSGSETU
if $DATA(XQUIT)
GOTO DONE
+4 DO MARFORM^PSGMUTL
if PSGMARB=0
GOTO DONE
if PSGMARB'=1
SET PSGMARS=3
+5 if PSGMARB'=1
GOTO ENDATE
FOR
READ !!,"Print (C)ontinuous sheets, (P)RN sheets, or (B)oth? B// ",X:DTIME
if '$TEST
WRITE $CHAR(7)
if '$TEST
SET X="^"
if "^CPB"[X&($LENGTH(X)<2)
QUIT
if X'?1."?"
WRITE $CHAR(7)," ??"
if X?1."?"
DO SHTH
+6 if X="^"
GOTO DONE
IF X=""
WRITE " (Both)"
SET PSGMARS=3
+7 IF '$TEST
WRITE $SELECT(X="C":"ontinuous",X="P":"RN",1:"oth")
SET PSGMARS=$FIND("CPB",X)-1
+8 ;
ENDATE ; get start date
+1 SET %DT="ETX"
SET Y=-1
FOR
WRITE !!,"Enter START DATE/TIME for 24 hour MAR: "
READ X:DTIME
if '$TEST
WRITE $CHAR(7)
if '$TEST
SET X="^"
if "^"[X
QUIT
if X?1."?"
DO DH
DO ^%DT
if Y>0
QUIT
+2 IF Y'>0
WRITE $CHAR(7),!!?5,"(No date selected for MAR run.)"
GOTO DONE
+3 SET PSGMARDT=+$EXTRACT(Y,1,10)
if $PIECE(PSGMARDT,".",2)
Begin DoDot:1
+4 SET PSGPLS=PSGMARDT
SET PSGPLF=$$EN^PSGCT(PSGPLS,-1)
SET ST=$PIECE(PSGPLS_0,".",2)
SET FT=$PIECE(PSGPLF_0,".",2)
+5 SET PSGMARSD=$EXTRACT(ST,1,2)
SET PSGMARFD=$EXTRACT(FT,1,2)
if 'PSGMARSD
SET PSGMARSD="01"
SET PSGMARFD=$SELECT(+PSGMARSD=1:24,PSGMARSD=PSGMARFD:PSGMARSD-1,1:PSGMARFD)
if $LENGTH(PSGMARFD)<2
SET PSGMARFD=0_PSGMARFD
+6 IF ST>1
SET X1=$PIECE(PSGPLF,".")
SET X2=1
DO C^%DTC
SET PSGPLF=X
+7 SET PSGPLS=+(PSGPLS_"."_ST)
SET PSGPLF=+(PSGPLF_"."_FT)
+8 SET PSGMARSP=$$ENDTC2^PSGMI(PSGPLS)
SET PSGMARFP=$$ENDTC2^PSGMI(PSGPLF)
End DoDot:1
+9 DO NOW^%DTC
SET PSGDT=%
SET (PSGMARWG,PSJPWDO)=0
SET PSGMARWD=+$GET(PSJPWD)
SET PSGRBPPN=""
+10 IF '$DATA(PSGOENOF)
SET (PSGP,PSGPAT)=0
SET PSGSSH="MAR"
DO ^PSGSEL
if "^"[PSGSS
GOTO OUT
DO @PSGSS
if $GET(PSJSTOP)
GOTO OUT
+11 if $$MEDTYPE^PSJMDIR(PSGMARWD)
GOTO OUT
SET PSGMTYPE=Y
+12 DO DEV
IF POP!$DATA(IO("Q"))
GOTO DONE
+13 ;
ENQ ; when queued
+1 NEW F,P,DRGI,DRGN,DRGT,PSIVUP,PSJORIFN,PSGMSORT
+2 SET PSJACNWP=1
USE IO
DO ^PSGMAR0
IF $DATA(^TMP($JOB))>9
DO ^PSGMAR1
+3 ;DAM 5-01-07
+4 IF $DATA(PSGREP)
KILL ^XTMP(PSGREP)
+5 ;END DAM
+6 DO ^%ZISC
GOTO DONE
+7 ;
OUT WRITE $CHAR(7),!!?5,"(No patient(s) selected for MAR run.)"
KILL PSGPLF,PSGPLS
DONE ;
+1 IF '$DATA(PSGOENOF)
DO ENKV^PSGSETU
+2 KILL AD,ASTERS,BD,BLN,C,CNTR,DA1,DA2,DAO,DFN,DRG,DX,EXPIRE,FD,FT,HX,L,LN1,LN14,LN2,LN3,LN4,LN5,LN6,LN7,MOS,MSG1,MSG2,ND2,NG,OPST,PSJJORD,PAGE,PN,PND,PNN,PPN,PRB,PSEX,PSSN,PSGPLF,PSGPLS,PSGPLC,PSGPLO,QX,TMSTR,XX
+3 KILL PSGADR,PSGALG,PSGD,PSGDW,PSGFORM,PSGMAR,PSGMARB,PSGMARDF,PSGMARDT,PSGMARED,PSGMARGD,PSGMARFD,PSGMARFP,PSGMAROC,PSGMARS,PSGMARSD,PSGL
+4 KILL PSGMARSM,PSGMARSP,PSGMARTS,PSGMARWD,PSGMARWG,PSGMARWN,PSGMARWS,PSGMPG,PSGMPGN,PSGORD,PSGPAT,PSJDIET
+5 KILL PSJSTOP,PSJPWDO,PSGMARO,ST,PSGSS,PSGSSH,PSTXDT,PST,PTM,PWDN,PSJACNWP,QST,R,RB,RCT,S,SD,SM,SPACES,TM,T,TD,TS,WD,WDN,WG,WGN,WS,WT,X1,X2,Y1,^TMP($JOB)
+6 KILL PSGST,PSGTM,PSGTMALL,XTYPE,PSGLRPH,PSGMTYPE,PSGPG,PSGMFOR,PSGMTYPE,PSGPG,PSGRBPPN,PSGS0XT,PSGS0Y
+7 KILL HT,ON,PSGOENOF,PSGOES,PSGRBPPN,PSGS0XT,PSGST,PSGTIR,PSGWD,XQUIT,ZTDES,ONHOLD
+8 DO ENKV^PSGLOI
+9 QUIT
+10 ;
G ; get ward group
+1 SET DIC="^PS(57.5,"
SET DIC(0)="QEAMI"
SET DIC("A")="Select WARD GROUP: "
WRITE !
DO ^DIC
KILL DIC
Begin DoDot:1
+2 IF X="^OTHER"
SET PSGMARWG="^OTHER"
QUIT
+3 SET PSGMARWG=+Y
+4 IF +Y'>0
SET PSJSTOP=1
End DoDot:1
IF $GET(PSJSTOP)=1
QUIT
+5 DO RBPPN^PSJMDIR
+6 QUIT
+7 ;
W ; get ward
+1 SET DIC="^DIC(42,"
SET DIC(0)="QEAMI"
SET DIC("A")="Select WARD: "
WRITE !
DO ^DIC
KILL DIC
SET PSGMARWD=+Y
IF +Y'>0
SET PSJSTOP=1
QUIT
+2 SET PSGWD=PSGMARWD
DO ADMTM^PSJMDIR
+3 if 'PSJSTOP
DO RBPPN^PSJMDIR
+4 QUIT
+5 ;
P ; get patient
+1 KILL PSGPAT
SET PSGPAT=0
FOR CNTR=0:1
if CNTR
SET PSGDICA="another"
if 'PSGMARB
DO ENP^PSGGAO
if PSGMARB
DO ENDPT^PSGP
if PSGP'>0
QUIT
Begin DoDot:1
+2 SET PSGPAT(PSGP)=""
SET PSGPAT=PSGP
+3 ;*** PSGMARWD=1 when all patients are select from the same ward.
+4 if '$GET(PSJPWDO)
SET (PSGMARWD,PSJPWDO)=PSJPWD
SET PSGMARWD=$SELECT('$GET(PSGMARWD):0,PSJPWDO=PSJPWD:PSJPWD,1:0)
End DoDot:1
+5 SET Y=PSGPAT
if Y'>0
SET PSJSTOP=1
KILL PSGDICA
+6 QUIT
+7 ;
C ;
+1 ;DAM Add new variable to hold numerical value of CLINIC 5-01-07
+2 SET PSGCLNC=""
+3 KILL DIR
SET DIR(0)="FAO"
SET DIR("A")="Select CLINIC: "
+4 SET DIR("?")="^D CDIC^PSGVBW"
WRITE !
DO ^DIR
CDIC ;
+1 KILL DIC
SET DIC="^SC("
SET DIC(0)="QEMIZ"
DO ^DIC
KILL DIC
if +Y>0
SET CL=+Y
SET PSGCLNC=+Y
IF +Y<0
SET PSJSTOP=1
QUIT
+2 if X["?"
WRITE !!,"Enter the clinic you want to use to select patients for processing.",!
+3 QUIT
L ;
+1 KILL DIR
SET DIR(0)="FAO"
SET DIR("A")="Select CLINIC GROUP: "
+2 SET DIR("?")="^D LDIC^PSGVBW"
WRITE !
DO ^DIR
LDIC ;
+1 KILL DIC
SET DIC="^PS(57.8,"
SET DIC(0)="QEMI"
DO ^DIC
KILL DIC
if +Y>0
SET CG=+Y
IF +Y<0
SET PSJSTOP=1
QUIT
+2 if X["?"
WRITE !!,"Enter the name of the clinic group you want to use to select patients for processing."
+3 QUIT
DEV ; ask print device and queue if asked to
+1 KILL ZTSAVE
SET PSGTIR="ENQ^PSGMAR"
SET ZTDESC="24 HOUR MAR"
if PSGMARB
SET ZTSAVE("PSGMARS")=""
Begin DoDot:1
+2 FOR X="PSGMARWG","PSGMARWD","PSGP","PSGPAT(","PSGDT","PSGMARDT","PSGSS","PSGMARB","PSGMARDF","PSGMTYPE","PSGRBPPN","^TMP($J,","PSGINCL","PSGINCLG","PSGINWD","PSGINWDG"
SET ZTSAVE(X)=""
End DoDot:1
+3 IF $PIECE(PSGMARDT,".",2)
FOR X="PSGPLS","PSGPLF","PSGMARSD","PSGMARFD","PSGMARSP","PSGMARFP"
SET ZTSAVE(X)=""
+4 IF PSGSS="W"
FOR X="PSGTMALL","PSGTM","PSGTM("
SET ZTSAVE(X)=""
+5 DO ENDEV^PSGTI
if POP
WRITE !!?3,"No device selected for 24 hour MAR run."
if $DATA(ZTSK)
WRITE !?3,"24 hour MAR Queued!"
KILL ZTSK
QUIT
+6 IF 'IO("Q")
USE IO
+7 ;
BH ;
+1 WRITE !!," Enter a 'Y' to print BLANK (no data) MARs for the patient(s) you select.",!,"Enter an 'N' (or press the RETURN key) to print MARs complete with orders.",!,"Enter an '^' to exit this option now."
QUIT
+2 ;
DH ;
+1 WRITE !!?2,"Enter the START DATE of the 24 hour period for which this MAR is to print.",!,"Unless the BLANK MARs are selected, all orders for the patient(s) selected that",!,"are (or were) active during the date range selected will print."
+2 WRITE !?2,"Time is not required. If time is not entered, the default time is used (if",!,"found in the site parameters). If the default time is not found, the start of",!,"the day is used."
QUIT
+3 ;
SHTH ;
+1 WRITE !!?2,"Enter 'C' to print ONLY CONTINUOUS blank sheets for the patients selected.",!,"Enter 'P' to print ONLY PRN sheets. Enter 'B' (or press RETURN) to print BOTH",!,"sheets for each patient."
QUIT
+2 ;
ENLM ;
+1 SET PSGOENOF=1
SET PSGPAT(PSGP)=""
SET PSGSS="P"
GOTO EN
