- 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 Jan 18, 2025@03:02:41 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