PSGMMAR ;BIR/CML3-MULTIPLE DAY MARS - MAIN DRIVER ;14 Oct 98 / 4:28 PM
;;5.0;INPATIENT MEDICATIONS ;**15,20,110,111,131,145,248**;16 DEC 97;Build 6
F R !!,"HOW MANY DAYS? (7/14) ",PSGMARDF:DTIME S:'$T PSGMARDF="^" Q:"^"[PSGMARDF Q:PSGMARDF=7!(PSGMARDF=14) W $C(7)," 7 OR 14 DAY MAR!!"
G:"^"[PSGMARDF DONE G EN
;
EN7 ;
S PSGMARDF=7 G EN
;
EN14 ;
S PSGMARDF=14
;
EN ;
NEW DRUGNAME,F,MARLB,NAME,UP,PSGOP
D ENCV^PSGSETU G:$D(XQUIT) DONE K PSGMAROF
;
EN1 ;
D MARFORM^PSGMUTL G:'PSGMARB DONE
;
ENOE ;
D SD^PSGMMARH W ! D ^DIR K DIR,DTOUT,DUOUT,DIRUT,DIROUT G:"^"[$E(Y) DONE S PSGMARS=$F("CPBO",Y)-1
;
DATE ;
S %DT="ETSX",Y=-1 F W !!,"Enter START DATE/TIME for "_PSGMARDF_" day MAR: " R X:DTIME W:'$T $C(7) S:'$T X="^" Q:"^"[X D:X?1."?" DH^PSGMMARH D ^%DT Q:Y>0
I Y'>0 W $C(7),!!?5,"(No date selected, or MAR run.)" G DONE
S PSGMARSD=+Y,X1=$P(+Y,"."),X2=PSGMARDF-1 D C^%DTC S PSGMARFD=X
D NOW^%DTC S PSGDT=%,(PSGMARWG,PSJPWDO)=0,PSGRBPPN="",PSGMARWD=+$G(PSJPWD)
I '$G(PSGMAROF),'$G(PSGOENOF)!($G(PSGSS)="") S (PSGP,PSGPAT,PSGMARWD)=0,PSGSSH="MAR" D ^PSGSEL G:"^"[PSGSS OUT D @PSGSS G:$G(PSJSTOP) OUT
I PSGMARB'=1 G:$$MEDTYPE^PSJMDIR(PSGMARWD) OUT S PSGMTYPE=Y
D DEV I POP!$D(IO("Q")) G DONE
;
ENQ ; when queued
N DRGI,DRGN,DRGT,LN,P,PSIVUP,PSJORIFN,PSGMSORT
D ^PSGMMAR0 I $D(^TMP($J))>9 D ^PSGMMAR1 K ^TMP($J)
;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(PSGVBY) D ENKV^PSGSETU
K:'$D(PSGVBY) PSGSS,PSGSSH
D ENKV^PSGLOI
K AD,ASTERS,BD,BLN,CNTR,DA1,DA2,DAO,DIC,DRG,DX,EXPIRE,FD,HX,L,LN1,LN14,LN2,LN3,LN31,LN32,LN4,LN5,LN6,LN7
K MOS,MSG1,MSG2,N,ND2,NAMENEED,NEED,OPST,PSJJORD,PAGE,PN,PND,PNN,PPN,PRB,PSEX,PSSN,PSGMAPA,PSGMAPB,PSGMAPC,PSGMAPD,PSGADR,PSGALG,PSGS0Y,PSGXDT
K PSGD,PSGDW,PSGMAR,PSGMARB,PSGMARDF,PSGMARED,PSGMARGD,PSGMARFD,PSGMARFP,PSGMAROC,PSGMAROF,PSGMARPT,PSGMARS,PSGMARSD,PSGMARSM,PSGMARSP
K PSGMARTS,PSGMARWD,PSGMARWG,PSGMARWN,PSGMARWS,PSGMPG,PSGMPGN,PSGORD,PSGPAT,PSJDIET
K DFN,NG,NO,ON,PST,PTM,PWDN,QST,PSJACNWP,R,RB,RCT,S,SD,SM,SPACES,TM,T,TD,TS,WD,WDN,WG,WGN,WS,WT,X1,X2,Y1
K PSJSTOP,PSJPWDO,PSGMARO,PSGMTYPE,PSGTM,PSGTMALL,XTYPE,PSGLRPH,PSGPG
K HT,PSGOENOF,PSGOES,PSGRBPPN,PSGS0XT,PSGST,PSGTIR,PSGWD,XQUIT,ZTDESC,ONHOLD
Q
;
G ;
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 ;
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 S Y=PSGMARWD
D:'PSJSTOP RBPPN^PSJMDIR
Q
;
P ;
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 5-01-07 Add new variable to hold numerical value of CLINIC
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 ;
K ZTSAVE S PSGTIR="ENQ^PSGMMAR",ZTDESC=PSGMARDF_" DAY MAR" F X="PSGMARWG","PSGMARWD","PSGP","PSGPAT(","PSGDT","PSGMARSD","PSGMARFD","PSGSS","PSGMARB","PSGMARDF","PSGMARS","PSGINCL","PSGINCLG","PSGINWD","PSGINWDG" S ZTSAVE(X)=""
F X="PSGMTYPE","PSGRBPPN","^TMP($J,","CL","CG","PSGCLNC" S ZTSAVE(X)="" ;PSJ*5*248 - Added clinic, clinic group
I PSGSS="W" F X="PSGTMALL","PSGTM","PSGTM(" S ZTSAVE(X)=""
D ENDEV^PSGTI W:POP !!?3,"No device selected for "_PSGMARDF_" day MAR run." W:$D(ZTSK) !?3,PSGMARDF_" Day MAR Queued!" K ZTSK Q
I 'IO("Q") U IO
;
ENOR S PSGP=+ORVP
ENLM ;
NEW VADM
D ENCV^PSGSETU I $D(QUIT) K PSGMARDF Q
D ^PSJAC S PSGPAT=1,PSGPAT(PSGP)="",PSGMAROF=1,PSGSS="P" G EN1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGMMAR 4524 printed Apr 09, 2024@21:03:16 Page 2
PSGMMAR ;BIR/CML3-MULTIPLE DAY MARS - MAIN DRIVER ;14 Oct 98 / 4:28 PM
+1 ;;5.0;INPATIENT MEDICATIONS ;**15,20,110,111,131,145,248**;16 DEC 97;Build 6
+2 FOR
READ !!,"HOW MANY DAYS? (7/14) ",PSGMARDF:DTIME
if '$TEST
SET PSGMARDF="^"
if "^"[PSGMARDF
QUIT
if PSGMARDF=7!(PSGMARDF=14)
QUIT
WRITE $CHAR(7)," 7 OR 14 DAY MAR!!"
+3 if "^"[PSGMARDF
GOTO DONE
GOTO EN
+4 ;
EN7 ;
+1 SET PSGMARDF=7
GOTO EN
+2 ;
EN14 ;
+1 SET PSGMARDF=14
+2 ;
EN ;
+1 NEW DRUGNAME,F,MARLB,NAME,UP,PSGOP
+2 DO ENCV^PSGSETU
if $DATA(XQUIT)
GOTO DONE
KILL PSGMAROF
+3 ;
EN1 ;
+1 DO MARFORM^PSGMUTL
if 'PSGMARB
GOTO DONE
+2 ;
ENOE ;
+1 DO SD^PSGMMARH
WRITE !
DO ^DIR
KILL DIR,DTOUT,DUOUT,DIRUT,DIROUT
if "^"[$EXTRACT(Y)
GOTO DONE
SET PSGMARS=$FIND("CPBO",Y)-1
+2 ;
DATE ;
+1 SET %DT="ETSX"
SET Y=-1
FOR
WRITE !!,"Enter START DATE/TIME for "_PSGMARDF_" day MAR: "
READ X:DTIME
if '$TEST
WRITE $CHAR(7)
if '$TEST
SET X="^"
if "^"[X
QUIT
if X?1."?"
DO DH^PSGMMARH
DO ^%DT
if Y>0
QUIT
+2 IF Y'>0
WRITE $CHAR(7),!!?5,"(No date selected, or MAR run.)"
GOTO DONE
+3 SET PSGMARSD=+Y
SET X1=$PIECE(+Y,".")
SET X2=PSGMARDF-1
DO C^%DTC
SET PSGMARFD=X
+4 DO NOW^%DTC
SET PSGDT=%
SET (PSGMARWG,PSJPWDO)=0
SET PSGRBPPN=""
SET PSGMARWD=+$GET(PSJPWD)
+5 IF '$GET(PSGMAROF)
IF '$GET(PSGOENOF)!($GET(PSGSS)="")
SET (PSGP,PSGPAT,PSGMARWD)=0
SET PSGSSH="MAR"
DO ^PSGSEL
if "^"[PSGSS
GOTO OUT
DO @PSGSS
if $GET(PSJSTOP)
GOTO OUT
+6 IF PSGMARB'=1
if $$MEDTYPE^PSJMDIR(PSGMARWD)
GOTO OUT
SET PSGMTYPE=Y
+7 DO DEV
IF POP!$DATA(IO("Q"))
GOTO DONE
+8 ;
ENQ ; when queued
+1 NEW DRGI,DRGN,DRGT,LN,P,PSIVUP,PSJORIFN,PSGMSORT
+2 DO ^PSGMMAR0
IF $DATA(^TMP($JOB))>9
DO ^PSGMMAR1
KILL ^TMP($JOB)
+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)
IF '$DATA(PSGVBY)
DO ENKV^PSGSETU
+2 if '$DATA(PSGVBY)
KILL PSGSS,PSGSSH
+3 DO ENKV^PSGLOI
+4 KILL AD,ASTERS,BD,BLN,CNTR,DA1,DA2,DAO,DIC,DRG,DX,EXPIRE,FD,HX,L,LN1,LN14,LN2,LN3,LN31,LN32,LN4,LN5,LN6,LN7
+5 KILL MOS,MSG1,MSG2,N,ND2,NAMENEED,NEED,OPST,PSJJORD,PAGE,PN,PND,PNN,PPN,PRB,PSEX,PSSN,PSGMAPA,PSGMAPB,PSGMAPC,PSGMAPD,PSGADR,PSGALG,PSGS0Y,PSGXDT
+6 KILL PSGD,PSGDW,PSGMAR,PSGMARB,PSGMARDF,PSGMARED,PSGMARGD,PSGMARFD,PSGMARFP,PSGMAROC,PSGMAROF,PSGMARPT,PSGMARS,PSGMARSD,PSGMARSM,PSGMARSP
+7 KILL PSGMARTS,PSGMARWD,PSGMARWG,PSGMARWN,PSGMARWS,PSGMPG,PSGMPGN,PSGORD,PSGPAT,PSJDIET
+8 KILL DFN,NG,NO,ON,PST,PTM,PWDN,QST,PSJACNWP,R,RB,RCT,S,SD,SM,SPACES,TM,T,TD,TS,WD,WDN,WG,WGN,WS,WT,X1,X2,Y1
+9 KILL PSJSTOP,PSJPWDO,PSGMARO,PSGMTYPE,PSGTM,PSGTMALL,XTYPE,PSGLRPH,PSGPG
+10 KILL HT,PSGOENOF,PSGOES,PSGRBPPN,PSGS0XT,PSGST,PSGTIR,PSGWD,XQUIT,ZTDESC,ONHOLD
+11 QUIT
+12 ;
G ;
+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 ;
+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
SET Y=PSGMARWD
+3 if 'PSJSTOP
DO RBPPN^PSJMDIR
+4 QUIT
+5 ;
P ;
+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 5-01-07 Add new variable to hold numerical value of CLINIC
+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 ;
+1 KILL ZTSAVE
SET PSGTIR="ENQ^PSGMMAR"
SET ZTDESC=PSGMARDF_" DAY MAR"
FOR X="PSGMARWG","PSGMARWD","PSGP","PSGPAT(","PSGDT","PSGMARSD","PSGMARFD","PSGSS","PSGMARB","PSGMARDF","PSGMARS","PSGINCL","PSGINCLG","PSGINWD","PSGINWDG"
SET ZTSAVE(X)=""
+2 ;PSJ*5*248 - Added clinic, clinic group
FOR X="PSGMTYPE","PSGRBPPN","^TMP($J,","CL","CG","PSGCLNC"
SET ZTSAVE(X)=""
+3 IF PSGSS="W"
FOR X="PSGTMALL","PSGTM","PSGTM("
SET ZTSAVE(X)=""
+4 DO ENDEV^PSGTI
if POP
WRITE !!?3,"No device selected for "_PSGMARDF_" day MAR run."
if $DATA(ZTSK)
WRITE !?3,PSGMARDF_" Day MAR Queued!"
KILL ZTSK
QUIT
+5 IF 'IO("Q")
USE IO
+6 ;
ENOR SET PSGP=+ORVP
ENLM ;
+1 NEW VADM
+2 DO ENCV^PSGSETU
IF $DATA(QUIT)
KILL PSGMARDF
QUIT
+3 DO ^PSJAC
SET PSGPAT=1
SET PSGPAT(PSGP)=""
SET PSGMAROF=1
SET PSGSS="P"
GOTO EN1
