- PSBOMM2 ;BIRMINGHAM/EFC-MISSED MEDS ;2/6/21 17:43
- ;;3.0;BAR CODE MED ADMIN;**26,32,51,62,74,88,106**;Mar 2004;Build 43
- ;Per VA Directive 6402, this routine should not be modified.
- ;
- ;*106 move Clinic report code from psbomm to here due to routine size was exceeded in psbomm
- ;
- MISSED(PSBADMN,PSBEDIT,PSBXDT) ;
- N PSBMISD,PSBAUDT,PSBSTRT2
- S PSBSTRT2=(PSBXDT\1) F D Q:PSBODD S PSBSTRT2=$$FMADD^XLFDT(PSBSTRT2,1) Q:PSBSTRT2>PSBSTOP
- .F Y=1:1:$L(PSBADMN,"-") S PSBDT=+("."_$P(PSBADMN,"-",Y))+(PSBSTRT2) D
- ..S PSBMISD=$$CHECK(PSBDT)
- ..;Check Audited Admin Times for Missed Med
- ..I PSBMISD F I=1:1:$P(PSBOACTL(0),U,4) I $P($G(PSBOACTL(I,1)),U,3)["ADMIN TIMES" D Q:'PSBMISD
- ...Q:$P(PSBOACTL(I,1),U)<PSBSTRT2
- ...;Q:$P(PSBOACTL(I,1),U)>((PSBSTOP\1)+.2400) - remove ending date check, all audits should affect report, PSB*3*88
- ...Q:$P(PSBOACTL(I,1),U)<PSBDT
- ...S PSBAUDT=+("."_$P(PSBOACTL(I,2),"-",Y))+(PSBSTRT2\1)
- ...S PSBMISD=$$CHECK(PSBAUDT),PSBEDIT=1
- ..I PSBMISD D
- ...Q:'$$OKAY^PSBVDLU1(PSBOST,PSBSTRT2,PSBSCH,PSBONX,$P(^TMP("PSJ",$J,PSBX,3),U,2),PSBFREQ,PSBOSTS)
- ...S:'$D(^TMP("PSB",$J,DFN,PSBDT,"* "_PSBOITX,PSBONX)) ^TMP("PSB",$J,DFN,PSBDT,PSBOITX,PSBONX)=""
- ...D UDCONT
- Q
- CHECK(PSBDT) ;
- I PSBDT<PSBOST Q 0 ; Order Start Date
- I PSBDT'<PSBOSP Q 0 ; Order Stop Date
- I PSBDT<PSBSTRT Q 0 ; Report Window
- I PSBDT>PSBSTOP Q 0 ; Report Window
- I $D(^PSB(53.79,"AORD",DFN,PSBONX,PSBDT)) D Q:PSBSTUS'="N" $G(PART,0)
- .K PART S PSBIX=$O(^PSB(53.79,"AORD",DFN,PSBONX,PSBDT,"")),PSBSTUS=$P(^PSB(53.79,PSBIX,0),U,9)
- .I PSBOCRIT[PSBOSTS D:(PSBACRIT[PSBSTUS) Q
- ..I (PSBSTUS="G")&$D(^PSB(53.79,PSBIX,.5)) D
- ...S X=0 F S X=$O(^PSB(53.79,PSBIX,.5,X)) Q:+X=0 D
- ....I $P(^PSB(53.79,PSBIX,.5,X,0),U,2)>$P(^PSB(53.79,PSBIX,.5,X,0),U,3) D S PSBOITX=$E(PSBOITX,3,999)
- .....S PSBOITX="* "_PSBOITX S ^TMP("PSB",$J,DFN,PSBDT,PSBOITX,PSBONX,"X")="Units Ordered: "_$P(^PSB(53.79,PSBIX,.5,X,0),U,2)_" Units Given: "_$P(^PSB(53.79,PSBIX,.5,X,0),U,3)_" Admin. Status: * Partial (Given)"
- .....S PART=1
- .....D:PSBINCC GCMNTS(PSBIX)
- ..I PSBSTUS'="G" I PSBACRIT[PSBSTUS S PART=1 S ^TMP("PSB",$J,DFN,PSBDT,PSBOITX,PSBONX,"X")="Admin. Status: ("_$S(PSBSTUS="":" *UNKNOWN* ",PSBSTUS="M":"Missing Dose",PSBSTUS="H":"Held",PSBSTUS="R":"Refused")_")" D:PSBINCC GCMNTS(PSBIX)
- Q 1
- UDCONT ;
- S PSBFLAG=0,J=1
- K ^TMP("PSB1",$J)
- F I=1:1:$P(PSBOACTL(0),U,4) D
- . I $P($G(PSBOACTL(I,1)),U,4)["ON HOLD"!($P($G(PSBOACTL(I,1)),U,4)="HOLD") S ^TMP("PSB1",$J,DFN,J)="HOLD"_U_$E($P($G(PSBOACTL(I,1)),U,1),1,12)
- . I $P($G(PSBOACTL(I,1)),U,4)["TAKEN OFF HOLD"!($P($G(PSBOACTL(I,1)),U,4)["UNHOLD") S $P(^TMP("PSB1",$J,DFN,J),U,3)="OFF HOLD"_U_$E($P($G(PSBOACTL(I,1)),U,1),1,12),J=J+1
- D:$D(^TMP("PSB1",$J,DFN))&($P(PSBOACTL(0),U,4)'=1)
- .S J=0 F S J=$O(^TMP("PSB1",$J,DFN,J)) Q:'J Q:PSBFLAG D
- ..S PSBHDDT=$P(^TMP("PSB1",$J,DFN,J),U,2)
- ..S PSBHDST=$P(^TMP("PSB1",$J,DFN,J),U)
- ..S PSBOFDT=$P(^TMP("PSB1",$J,DFN,J),U,4)
- ..S PSBOFST=$P(^TMP("PSB1",$J,DFN,J),U,3)
- ..I PSBDT>PSBHDDT,PSBHDST="HOLD",PSBOFST'="" I PSBDT<PSBOFDT,PSBOFST="OFF HOLD" S PSBFLAG=2,PSBUNHD=PSBOFDT
- ..I PSBDT>PSBHDDT,PSBHDST="HOLD",PSBOFST="" S PSBFLAG=1
- K PSBCNT,TMP("PSB1",$J)
- S PSBOITX2=PSBOITX
- I $D(^TMP("PSB",$J,DFN,PSBDT,"* "_PSBOITX,PSBONX)) S PSBOITX="* "_PSBOITX
- I PSBFLAG=1 S ^TMP("PSB",$J,DFN,PSBDT,PSBOITX,PSBONX)="(On Hold) "_$$DTFMT(PSBHDDT)
- I PSBFLAG=2 S ^TMP("PSB",$J,DFN,PSBDT,PSBOITX,PSBONX)="(On Hold) "_$$DTFMT(PSBHDDT)_" "_"(Off Hold) "_$$DTFMT(PSBUNHD)
- S PSBOITX=PSBOITX2
- Q
- ;
- UDONE ;
- S PSBFLAG=0,J=1
- F I=1:1:$P(PSBOACTL(0),U,4) D
- .I $P($G(PSBOACTL(I,1)),U,4)["ON HOLD"!($P($G(PSBOACTL(I,1)),U,4)="HOLD") S ^TMP("PSB1",$J,DFN,J)="HOLD"_U_$E($P($G(PSBOACTL(I,1)),U,1),1,12)
- .I $P($G(PSBOACTL(I,1)),U,4)["TAKEN OFF HOLD"!($P($G(PSBOACTL(I,1)),U,4)["UNHOLD") S $P(^TMP("PSB1",$J,DFN,J),U,3)="OFF HOLD"_U_$E($P($G(PSBOACTL(I,1)),U,1),1,12),J=J+1
- D:$D(^TMP("PSB1",$J,DFN))&($P(PSBOACTL(0),U,4)'=1)
- .S J="" F S J=$O(^TMP("PSB1",$J,DFN,J)) Q:'J Q:PSBFLAG D
- ..S PSBHDDT=$P(^TMP("PSB1",$J,DFN,J),U,2)
- ..S PSBHDST=$P(^TMP("PSB1",$J,DFN,J),U)
- ..S PSBOFDT=$P(^TMP("PSB1",$J,DFN,J),U,4)
- ..S PSBOFST=$P(^TMP("PSB1",$J,DFN,J),U,3)
- ..I PSBOSTS="A",PSBHDST="HOLD",PSBOFST'="",'$D(^TMP("PSB1",$J,DFN,J+1)) I PSBSTOP>PSBOFDT,PSBOFST="OFF HOLD" S PSBFLAG=2,PSBUNHD=PSBOFDT
- ..I PSBOSTS="A",PSBHDST="HOLD",PSBOFST'="",PSBOFDT'<PSBSTOP S PSBFLAG=1
- ..I PSBOSTS="H",PSBHDST="HOLD",'$D(^TMP("PSB1",$J,DFN,J+1)) S PSBFLAG=1
- K PSBCNT,^TMP("PSB1",$J)
- S PSBOITX2=PSBOITX
- I $D(^TMP("PSB",$J,DFN,PSBDT,"* "_PSBOITX,PSBONX)) S PSBOITX="* "_PSBOITX
- I PSBFLAG=1 S ^TMP("PSB",$J,DFN,PSBDT,PSBOITX,PSBONX)="(On Hold) "_$$DTFMT(PSBHDDT)
- I PSBFLAG=2 S ^TMP("PSB",$J,DFN,PSBDT,PSBOITX,PSBONX)="(On Hold) "_$$DTFMT(PSBHDDT)_" "_"(Off Hold) "_$$DTFMT(PSBUNHD)
- S PSBOITX=PSBOITX2
- Q
- GCMNTS(XIEN) ;
- Q:'$D(^PSB(53.79,XIEN,.3,1))
- N X
- S X=$O(^PSB(53.79,XIEN,.3,""),-1) Q:+X=0 S ^TMP("PSB",$J,DFN,PSBDT,PSBOITX,PSBONX,.3)="Comment: "_$P(^PSB(53.79,XIEN,.3,X,0),U)
- Q
- PARTG1(XIEN) ;
- I $D(^PSB(53.79,XIEN)) D
- .S PSBSTUS=$P(^PSB(53.79,XIEN,0),U,9)
- .I PSBOCRIT[PSBOSTS I PSBACRIT[PSBSTUS D S PSBEXST=1 Q
- ..I (PSBSTUS="G")&$D(^PSB(53.79,XIEN,.5)) D
- ...S X=0 F S X=$O(^PSB(53.79,XIEN,.5,X)) Q:+X=0 D
- ....I $P(^PSB(53.79,XIEN,.5,X,0),U,2)>$P(^PSB(53.79,XIEN,.5,X,0),U,3) D S PSBOITX=$E(PSBOITX,3,999),PSBGVN=0
- .....S PSBOITX="* "_PSBOITX S ^TMP("PSB",$J,DFN,PSBDT,PSBOITX,PSBONX,"X")="Units Ordered: "_$P(^PSB(53.79,XIEN,.5,X,0),U,2)_" Units Given: "_$P(^PSB(53.79,XIEN,.5,X,0),U,3)_" Admin. Status: * Partial (Given)"
- .....I PSBINCC D GCMNTS(XIEN)
- ..I PSBSTUS'="G" D S PSBGVN=0
- ...I PSBACRIT[PSBSTUS S ^TMP("PSB",$J,DFN,PSBDT,PSBOITX,PSBONX,"X")="Admin. Status: ("_$S(PSBSTUS="":" *UNKNOWN* ",PSBSTUS="M":"Missing Dose",PSBSTUS="H":"Held",PSBSTUS="R":"Refused")_")"
- ...I PSBINCC D GCMNTS(XIEN)
- Q
- LN1 ;
- W !,$TR($J("",IOM)," ","-")
- Q
- DEFLT ;
- S PSBFUTR=$TR(PSBRPT(1),"~","^")
- Q:PSBRPT(1)]""
- S PSBFUTR="^^^^1^^1^1^^^^^^^^1^1^1" ;default MM Report settings Per GUI MM report...
- S X01=""
- D RPC^PSBPAR(.X01,"GETPAR","ALL","PSB RPT INCL COMMENTS")
- S $P(PSBRPT(.2),U,8)=+X01(0)
- K PSBSTOP S PSBSTOP=$P(PSBRPT(.1),U,6)+$P(PSBRPT(.1),U,9)
- Q
- DTFMT(DT) ;
- N Y,X
- I +DT'>0 S DTFMT=DT Q DTFMT
- S Y=DT,X=$E($P(Y,".",2)_"0000",1,4)
- S DTFMT=$TR($J(+$E(Y,4,5),2)_"/"_$J(+$E(Y,6,7),2)_"/"_($E(Y,1,3)+1700)," ","0")_"@"_X
- Q DTFMT
- ;
- CLINIC ;Clinic report *106
- W $$CLNHDR()
- I '$O(^TMP("PSB",$J,0)) W !,"No Missed Medications Found" Q
- S PSBSORT=$P(PSBRPT(.1),U,5)
- F DFN=0:0 S DFN=$O(^TMP("PSB",$J,DFN)) Q:'DFN D
- .S PSBDX=$S(PSBSORT="P":$P(^DPT(DFN,0),U),1:$G(^DPT(DFN,.1))_" "_$G(^(.101)))
- .S:PSBDX="" PSBDX=$P(^DPT(DFN,0),U)
- .S ^TMP("PSB",$J,"B",PSBDX,DFN)=""
- S PSBDX=""
- F S PSBDX=$O(^TMP("PSB",$J,"B",PSBDX)) Q:PSBDX="" D
- .F DFN=0:0 S DFN=$O(^TMP("PSB",$J,"B",PSBDX,DFN)) Q:'DFN D
- ..W !
- ..S PSBDT=""
- ..F S PSBDT=$O(^TMP("PSB",$J,DFN,PSBDT)) Q:PSBDT="" D
- ...W !
- ...K VAR1,VAR2,VAR3 ;reset held/refused to prevent line feed
- ...W:PSBDT["ONE-TIME" !
- ...S PSBOITX=""
- ...F S PSBOITX=$O(^TMP("PSB",$J,DFN,PSBDT,PSBOITX)) Q:PSBOITX="" D
- ....S PSBONX=""
- ....F S PSBONX=$O(^TMP("PSB",$J,DFN,PSBDT,PSBOITX,PSBONX)) Q:PSBONX="" D
- .....;if previously held/refused lines printed, need line feed *58
- .....I ($G(VAR1)]"")!($G(VAR2)]"")!($G(VAR3)]"") W:'$G(RMV) ! K RMV
- .....K VAR1,VAR2,VAR3,SP I $Y>(IOSL-9) W $$CLNHDR()
- .....D PSJ1^PSBVT(DFN,PSBONX)
- .....S PSBVNI=$S(PSBVNI]"":PSBVNI,1:"***")
- .....; print remove line 1st *83
- .....S RMV=0
- .....D:$D(^TMP("PSB",$J,DFN,PSBDT,PSBOITX,PSBONX,"RM"))
- ......W !,$O(PSBS(DFN,PSBONX,"")),?11,PSBVNI,?17,$P(^DPT(DFN,0),U)
- ......W ?49,$S(+PSBDT>0:$$DTFMT^PSBOMM2(PSBDT),1:PSBDT),?66,PSBOITX
- ......W ?103,PSBCLORD
- ......W !,?69,"(Remove)" S RMV=1
- .....;print Give if exists for a RM just printed, or no RM printed
- .....I 'RMV!(RMV&$D(^TMP("PSB",$J,DFN,PSBDT,PSBOITX,PSBONX))=11) D
- ......W !,$O(PSBS(DFN,PSBONX,"")),?11,PSBVNI,?17,$P(^DPT(DFN,0),U)
- ......W:PSBDT'["ONE-TIME" ?49,$S(+PSBDT>0:$$DTFMT^PSBOMM2(PSBDT),1:PSBDT),?66,PSBOITX
- ......W:PSBDT'["ONE-TIME" ?103,PSBCLORD
- .....;*106 adds the hazardous handle/dispose notices
- .....I (PSBHAZDS=1)!(PSBHAZHN=1) W !
- .....I PSBHAZHN=1 W ?92,"<<HAZ HANDLE>> " ;*106 hazhn
- .....I PSBHAZDS=1 W ?92,"<<HAZ DISPOSE>>" ;*106 hazds, if hazhn printed 1st, then this will print after that and not at 92, desired.
- .....S VAR1=$G(^TMP("PSB",$J,DFN,PSBDT,PSBOITX,PSBONX))
- .....S VAR2=$G(^TMP("PSB",$J,DFN,PSBDT,PSBOITX,PSBONX,"X"))
- .....S VAR3=$G(^TMP("PSB",$J,DFN,PSBDT,PSBOITX,PSBONX,.3))
- .....I PSBDT["ONE-TIME" D Q
- ......W !,PSBDT,?37,PSBOITX S SP=1 W:PSBCLINORD ?103,PSBCLORD
- ......I VAR1]"" W !,?37,$P(VAR1,U,1) S SP=1
- ......I VAR2]"" W:$G(SP) ! W ?37,VAR2
- ......I VAR3]"" W !,$$WRAP^PSBO(37,102,VAR3)
- ......W !?3,"Start Date/Time: ",?21,$O(PSBSTXT(PSBONX,DFN,"")) ;DFN added to PSBSTXT array in PSB*3*52
- ......W !?3,"Stop Date/Time: ",?21,$O(PSBSTXP(PSBONX,DFN,"")) ;DFN added to PSBSTXP array in PSB*3*52
- ......W !
- .....;detail line additional info
- .....S SP=1
- .....I VAR1]"" W !,?57,VAR1 S SP=1
- .....I VAR2]"" W:$G(SP) ! W ?57,VAR2
- .....I VAR3]"" W !,$$WRAP^PSBO(57,82,VAR3)
- Q
- ;
- CLNHDR() ; *106
- D CLINIC^PSBOHDR(.PSBRPT,.PSBHDR,,,PSBSRCHL)
- W !,"Order Sts",?11,"Ver",?17,"Patient",?49,"Missed Date/Time",?66,"Medication",?103,"Location"
- D LN1^PSBOMM2
- Q ""
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSBOMM2 9567 printed Jan 18, 2025@02:41:58 Page 2
- PSBOMM2 ;BIRMINGHAM/EFC-MISSED MEDS ;2/6/21 17:43
- +1 ;;3.0;BAR CODE MED ADMIN;**26,32,51,62,74,88,106**;Mar 2004;Build 43
- +2 ;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- +4 ;*106 move Clinic report code from psbomm to here due to routine size was exceeded in psbomm
- +5 ;
- MISSED(PSBADMN,PSBEDIT,PSBXDT) ;
- +1 NEW PSBMISD,PSBAUDT,PSBSTRT2
- +2 SET PSBSTRT2=(PSBXDT\1)
- FOR
- Begin DoDot:1
- +3 FOR Y=1:1:$LENGTH(PSBADMN,"-")
- SET PSBDT=+("."_$PIECE(PSBADMN,"-",Y))+(PSBSTRT2)
- Begin DoDot:2
- +4 SET PSBMISD=$$CHECK(PSBDT)
- +5 ;Check Audited Admin Times for Missed Med
- +6 IF PSBMISD
- FOR I=1:1:$PIECE(PSBOACTL(0),U,4)
- IF $PIECE($GET(PSBOACTL(I,1)),U,3)["ADMIN TIMES"
- Begin DoDot:3
- +7 if $PIECE(PSBOACTL(I,1),U)<PSBSTRT2
- QUIT
- +8 ;Q:$P(PSBOACTL(I,1),U)>((PSBSTOP\1)+.2400) - remove ending date check, all audits should affect report, PSB*3*88
- +9 if $PIECE(PSBOACTL(I,1),U)<PSBDT
- QUIT
- +10 SET PSBAUDT=+("."_$PIECE(PSBOACTL(I,2),"-",Y))+(PSBSTRT2\1)
- +11 SET PSBMISD=$$CHECK(PSBAUDT)
- SET PSBEDIT=1
- End DoDot:3
- if 'PSBMISD
- QUIT
- +12 IF PSBMISD
- Begin DoDot:3
- +13 if '$$OKAY^PSBVDLU1(PSBOST,PSBSTRT2,PSBSCH,PSBONX,$PIECE(^TMP("PSJ",$JOB,PSBX,3),U,2),PSBFREQ,PSBOSTS)
- QUIT
- +14 if '$DATA(^TMP("PSB",$JOB,DFN,PSBDT,"* "_PSBOITX,PSBONX))
- SET ^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX)=""
- +15 DO UDCONT
- End DoDot:3
- End DoDot:2
- End DoDot:1
- if PSBODD
- QUIT
- SET PSBSTRT2=$$FMADD^XLFDT(PSBSTRT2,1)
- if PSBSTRT2>PSBSTOP
- QUIT
- +16 QUIT
- CHECK(PSBDT) ;
- +1 ; Order Start Date
- IF PSBDT<PSBOST
- QUIT 0
- +2 ; Order Stop Date
- IF PSBDT'<PSBOSP
- QUIT 0
- +3 ; Report Window
- IF PSBDT<PSBSTRT
- QUIT 0
- +4 ; Report Window
- IF PSBDT>PSBSTOP
- QUIT 0
- +5 IF $DATA(^PSB(53.79,"AORD",DFN,PSBONX,PSBDT))
- Begin DoDot:1
- +6 KILL PART
- SET PSBIX=$ORDER(^PSB(53.79,"AORD",DFN,PSBONX,PSBDT,""))
- SET PSBSTUS=$PIECE(^PSB(53.79,PSBIX,0),U,9)
- +7 IF PSBOCRIT[PSBOSTS
- if (PSBACRIT[PSBSTUS)
- Begin DoDot:2
- +8 IF (PSBSTUS="G")&$DATA(^PSB(53.79,PSBIX,.5))
- Begin DoDot:3
- +9 SET X=0
- FOR
- SET X=$ORDER(^PSB(53.79,PSBIX,.5,X))
- if +X=0
- QUIT
- Begin DoDot:4
- +10 IF $PIECE(^PSB(53.79,PSBIX,.5,X,0),U,2)>$PIECE(^PSB(53.79,PSBIX,.5,X,0),U,3)
- Begin DoDot:5
- +11 SET PSBOITX="* "_PSBOITX
- SET ^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX,"X")="Units Ordered: "_$PIECE(^PSB(53.79,PSBIX,.5,X,0),U,2)_" Units Given: "_$PIECE(^PSB(53.79,PSBIX,.5,X,0),U,3)_" Admin. Status: * Partial (Given)"
- +12 SET PART=1
- +13 if PSBINCC
- DO GCMNTS(PSBIX)
- End DoDot:5
- SET PSBOITX=$EXTRACT(PSBOITX,3,999)
- End DoDot:4
- End DoDot:3
- +14 IF PSBSTUS'="G"
- IF PSBACRIT[PSBSTUS
- SET PART=1
- SET ^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX,"X")="Admin. Status: ("_$SELECT(PSBSTUS="":" *UNKNOWN* ",PSBSTUS="M":"Missing Dose",PSBSTUS="H":"Held",PSBSTUS="R":"Refused")_")"
- if PSBINCC
- DO GCMNTS(PSBIX)
- End DoDot:2
- QUIT
- End DoDot:1
- if PSBSTUS'="N"
- QUIT $GET(PART,0)
- +15 QUIT 1
- UDCONT ;
- +1 SET PSBFLAG=0
- SET J=1
- +2 KILL ^TMP("PSB1",$JOB)
- +3 FOR I=1:1:$PIECE(PSBOACTL(0),U,4)
- Begin DoDot:1
- +4 IF $PIECE($GET(PSBOACTL(I,1)),U,4)["ON HOLD"!($PIECE($GET(PSBOACTL(I,1)),U,4)="HOLD")
- SET ^TMP("PSB1",$JOB,DFN,J)="HOLD"_U_$EXTRACT($PIECE($GET(PSBOACTL(I,1)),U,1),1,12)
- +5 IF $PIECE($GET(PSBOACTL(I,1)),U,4)["TAKEN OFF HOLD"!($PIECE($GET(PSBOACTL(I,1)),U,4)["UNHOLD")
- SET $PIECE(^TMP("PSB1",$JOB,DFN,J),U,3)="OFF HOLD"_U_$EXTRACT($PIECE($GET(PSBOACTL(I,1)),U,1),1,12)
- SET J=J+1
- End DoDot:1
- +6 if $DATA(^TMP("PSB1",$JOB,DFN))&($PIECE(PSBOACTL(0),U,4)'=1)
- Begin DoDot:1
- +7 SET J=0
- FOR
- SET J=$ORDER(^TMP("PSB1",$JOB,DFN,J))
- if 'J
- QUIT
- if PSBFLAG
- QUIT
- Begin DoDot:2
- +8 SET PSBHDDT=$PIECE(^TMP("PSB1",$JOB,DFN,J),U,2)
- +9 SET PSBHDST=$PIECE(^TMP("PSB1",$JOB,DFN,J),U)
- +10 SET PSBOFDT=$PIECE(^TMP("PSB1",$JOB,DFN,J),U,4)
- +11 SET PSBOFST=$PIECE(^TMP("PSB1",$JOB,DFN,J),U,3)
- +12 IF PSBDT>PSBHDDT
- IF PSBHDST="HOLD"
- IF PSBOFST'=""
- IF PSBDT<PSBOFDT
- IF PSBOFST="OFF HOLD"
- SET PSBFLAG=2
- SET PSBUNHD=PSBOFDT
- +13 IF PSBDT>PSBHDDT
- IF PSBHDST="HOLD"
- IF PSBOFST=""
- SET PSBFLAG=1
- End DoDot:2
- End DoDot:1
- +14 KILL PSBCNT,TMP("PSB1",$JOB)
- +15 SET PSBOITX2=PSBOITX
- +16 IF $DATA(^TMP("PSB",$JOB,DFN,PSBDT,"* "_PSBOITX,PSBONX))
- SET PSBOITX="* "_PSBOITX
- +17 IF PSBFLAG=1
- SET ^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX)="(On Hold) "_$$DTFMT(PSBHDDT)
- +18 IF PSBFLAG=2
- SET ^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX)="(On Hold) "_$$DTFMT(PSBHDDT)_" "_"(Off Hold) "_$$DTFMT(PSBUNHD)
- +19 SET PSBOITX=PSBOITX2
- +20 QUIT
- +21 ;
- UDONE ;
- +1 SET PSBFLAG=0
- SET J=1
- +2 FOR I=1:1:$PIECE(PSBOACTL(0),U,4)
- Begin DoDot:1
- +3 IF $PIECE($GET(PSBOACTL(I,1)),U,4)["ON HOLD"!($PIECE($GET(PSBOACTL(I,1)),U,4)="HOLD")
- SET ^TMP("PSB1",$JOB,DFN,J)="HOLD"_U_$EXTRACT($PIECE($GET(PSBOACTL(I,1)),U,1),1,12)
- +4 IF $PIECE($GET(PSBOACTL(I,1)),U,4)["TAKEN OFF HOLD"!($PIECE($GET(PSBOACTL(I,1)),U,4)["UNHOLD")
- SET $PIECE(^TMP("PSB1",$JOB,DFN,J),U,3)="OFF HOLD"_U_$EXTRACT($PIECE($GET(PSBOACTL(I,1)),U,1),1,12)
- SET J=J+1
- End DoDot:1
- +5 if $DATA(^TMP("PSB1",$JOB,DFN))&($PIECE(PSBOACTL(0),U,4)'=1)
- Begin DoDot:1
- +6 SET J=""
- FOR
- SET J=$ORDER(^TMP("PSB1",$JOB,DFN,J))
- if 'J
- QUIT
- if PSBFLAG
- QUIT
- Begin DoDot:2
- +7 SET PSBHDDT=$PIECE(^TMP("PSB1",$JOB,DFN,J),U,2)
- +8 SET PSBHDST=$PIECE(^TMP("PSB1",$JOB,DFN,J),U)
- +9 SET PSBOFDT=$PIECE(^TMP("PSB1",$JOB,DFN,J),U,4)
- +10 SET PSBOFST=$PIECE(^TMP("PSB1",$JOB,DFN,J),U,3)
- +11 IF PSBOSTS="A"
- IF PSBHDST="HOLD"
- IF PSBOFST'=""
- IF '$DATA(^TMP("PSB1",$JOB,DFN,J+1))
- IF PSBSTOP>PSBOFDT
- IF PSBOFST="OFF HOLD"
- SET PSBFLAG=2
- SET PSBUNHD=PSBOFDT
- +12 IF PSBOSTS="A"
- IF PSBHDST="HOLD"
- IF PSBOFST'=""
- IF PSBOFDT'<PSBSTOP
- SET PSBFLAG=1
- +13 IF PSBOSTS="H"
- IF PSBHDST="HOLD"
- IF '$DATA(^TMP("PSB1",$JOB,DFN,J+1))
- SET PSBFLAG=1
- End DoDot:2
- End DoDot:1
- +14 KILL PSBCNT,^TMP("PSB1",$JOB)
- +15 SET PSBOITX2=PSBOITX
- +16 IF $DATA(^TMP("PSB",$JOB,DFN,PSBDT,"* "_PSBOITX,PSBONX))
- SET PSBOITX="* "_PSBOITX
- +17 IF PSBFLAG=1
- SET ^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX)="(On Hold) "_$$DTFMT(PSBHDDT)
- +18 IF PSBFLAG=2
- SET ^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX)="(On Hold) "_$$DTFMT(PSBHDDT)_" "_"(Off Hold) "_$$DTFMT(PSBUNHD)
- +19 SET PSBOITX=PSBOITX2
- +20 QUIT
- GCMNTS(XIEN) ;
- +1 if '$DATA(^PSB(53.79,XIEN,.3,1))
- QUIT
- +2 NEW X
- +3 SET X=$ORDER(^PSB(53.79,XIEN,.3,""),-1)
- if +X=0
- QUIT
- SET ^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX,.3)="Comment: "_$PIECE(^PSB(53.79,XIEN,.3,X,0),U)
- +4 QUIT
- PARTG1(XIEN) ;
- +1 IF $DATA(^PSB(53.79,XIEN))
- Begin DoDot:1
- +2 SET PSBSTUS=$PIECE(^PSB(53.79,XIEN,0),U,9)
- +3 IF PSBOCRIT[PSBOSTS
- IF PSBACRIT[PSBSTUS
- Begin DoDot:2
- +4 IF (PSBSTUS="G")&$DATA(^PSB(53.79,XIEN,.5))
- Begin DoDot:3
- +5 SET X=0
- FOR
- SET X=$ORDER(^PSB(53.79,XIEN,.5,X))
- if +X=0
- QUIT
- Begin DoDot:4
- +6 IF $PIECE(^PSB(53.79,XIEN,.5,X,0),U,2)>$PIECE(^PSB(53.79,XIEN,.5,X,0),U,3)
- Begin DoDot:5
- +7 SET PSBOITX="* "_PSBOITX
- SET ^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX,"X")="Units Ordered: "_$PIECE(^PSB(53.79,XIEN,.5,X,0),U,2)_" Units Given: "_$PIECE(^PSB(53.79,XIEN,.5,X,0),U,3)_" Admin. Status: * Partial (Given)"
- +8 IF PSBINCC
- DO GCMNTS(XIEN)
- End DoDot:5
- SET PSBOITX=$EXTRACT(PSBOITX,3,999)
- SET PSBGVN=0
- End DoDot:4
- End DoDot:3
- +9 IF PSBSTUS'="G"
- Begin DoDot:3
- +10 IF PSBACRIT[PSBSTUS
- SET ^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX,"X")="Admin. Status: ("_$SELECT(PSBSTUS="":" *UNKNOWN* ",PSBSTUS="M":"Missing Dose",PSBSTUS="H":"Held",PSBSTUS="R":"Refused")_")"
- +11 IF PSBINCC
- DO GCMNTS(XIEN)
- End DoDot:3
- SET PSBGVN=0
- End DoDot:2
- SET PSBEXST=1
- QUIT
- End DoDot:1
- +12 QUIT
- LN1 ;
- +1 WRITE !,$TRANSLATE($JUSTIFY("",IOM)," ","-")
- +2 QUIT
- DEFLT ;
- +1 SET PSBFUTR=$TRANSLATE(PSBRPT(1),"~","^")
- +2 if PSBRPT(1)]""
- QUIT
- +3 ;default MM Report settings Per GUI MM report...
- SET PSBFUTR="^^^^1^^1^1^^^^^^^^1^1^1"
- +4 SET X01=""
- +5 DO RPC^PSBPAR(.X01,"GETPAR","ALL","PSB RPT INCL COMMENTS")
- +6 SET $PIECE(PSBRPT(.2),U,8)=+X01(0)
- +7 KILL PSBSTOP
- SET PSBSTOP=$PIECE(PSBRPT(.1),U,6)+$PIECE(PSBRPT(.1),U,9)
- +8 QUIT
- DTFMT(DT) ;
- +1 NEW Y,X
- +2 IF +DT'>0
- SET DTFMT=DT
- QUIT DTFMT
- +3 SET Y=DT
- SET X=$EXTRACT($PIECE(Y,".",2)_"0000",1,4)
- +4 SET DTFMT=$TRANSLATE($JUSTIFY(+$EXTRACT(Y,4,5),2)_"/"_$JUSTIFY(+$EXTRACT(Y,6,7),2)_"/"_($EXTRACT(Y,1,3)+1700)," ","0")_"@"_X
- +5 QUIT DTFMT
- +6 ;
- CLINIC ;Clinic report *106
- +1 WRITE $$CLNHDR()
- +2 IF '$ORDER(^TMP("PSB",$JOB,0))
- WRITE !,"No Missed Medications Found"
- QUIT
- +3 SET PSBSORT=$PIECE(PSBRPT(.1),U,5)
- +4 FOR DFN=0:0
- SET DFN=$ORDER(^TMP("PSB",$JOB,DFN))
- if 'DFN
- QUIT
- Begin DoDot:1
- +5 SET PSBDX=$SELECT(PSBSORT="P":$PIECE(^DPT(DFN,0),U),1:$GET(^DPT(DFN,.1))_" "_$GET(^(.101)))
- +6 if PSBDX=""
- SET PSBDX=$PIECE(^DPT(DFN,0),U)
- +7 SET ^TMP("PSB",$JOB,"B",PSBDX,DFN)=""
- End DoDot:1
- +8 SET PSBDX=""
- +9 FOR
- SET PSBDX=$ORDER(^TMP("PSB",$JOB,"B",PSBDX))
- if PSBDX=""
- QUIT
- Begin DoDot:1
- +10 FOR DFN=0:0
- SET DFN=$ORDER(^TMP("PSB",$JOB,"B",PSBDX,DFN))
- if 'DFN
- QUIT
- Begin DoDot:2
- +11 WRITE !
- +12 SET PSBDT=""
- +13 FOR
- SET PSBDT=$ORDER(^TMP("PSB",$JOB,DFN,PSBDT))
- if PSBDT=""
- QUIT
- Begin DoDot:3
- +14 WRITE !
- +15 ;reset held/refused to prevent line feed
- KILL VAR1,VAR2,VAR3
- +16 if PSBDT["ONE-TIME"
- WRITE !
- +17 SET PSBOITX=""
- +18 FOR
- SET PSBOITX=$ORDER(^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX))
- if PSBOITX=""
- QUIT
- Begin DoDot:4
- +19 SET PSBONX=""
- +20 FOR
- SET PSBONX=$ORDER(^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX))
- if PSBONX=""
- QUIT
- Begin DoDot:5
- +21 ;if previously held/refused lines printed, need line feed *58
- +22 IF ($GET(VAR1)]"")!($GET(VAR2)]"")!($GET(VAR3)]"")
- if '$GET(RMV)
- WRITE !
- KILL RMV
- +23 KILL VAR1,VAR2,VAR3,SP
- IF $Y>(IOSL-9)
- WRITE $$CLNHDR()
- +24 DO PSJ1^PSBVT(DFN,PSBONX)
- +25 SET PSBVNI=$SELECT(PSBVNI]"":PSBVNI,1:"***")
- +26 ; print remove line 1st *83
- +27 SET RMV=0
- +28 if $DATA(^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX,"RM"))
- Begin DoDot:6
- +29 WRITE !,$ORDER(PSBS(DFN,PSBONX,"")),?11,PSBVNI,?17,$PIECE(^DPT(DFN,0),U)
- +30 WRITE ?49,$SELECT(+PSBDT>0:$$DTFMT^PSBOMM2(PSBDT),1:PSBDT),?66,PSBOITX
- +31 WRITE ?103,PSBCLORD
- +32 WRITE !,?69,"(Remove)"
- SET RMV=1
- End DoDot:6
- +33 ;print Give if exists for a RM just printed, or no RM printed
- +34 IF 'RMV!(RMV&$DATA(^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX))=11)
- Begin DoDot:6
- +35 WRITE !,$ORDER(PSBS(DFN,PSBONX,"")),?11,PSBVNI,?17,$PIECE(^DPT(DFN,0),U)
- +36 if PSBDT'["ONE-TIME"
- WRITE ?49,$SELECT(+PSBDT>0:$$DTFMT^PSBOMM2(PSBDT),1:PSBDT),?66,PSBOITX
- +37 if PSBDT'["ONE-TIME"
- WRITE ?103,PSBCLORD
- End DoDot:6
- +38 ;*106 adds the hazardous handle/dispose notices
- +39 IF (PSBHAZDS=1)!(PSBHAZHN=1)
- WRITE !
- +40 ;*106 hazhn
- IF PSBHAZHN=1
- WRITE ?92,"<<HAZ HANDLE>> "
- +41 ;*106 hazds, if hazhn printed 1st, then this will print after that and not at 92, desired.
- IF PSBHAZDS=1
- WRITE ?92,"<<HAZ DISPOSE>>"
- +42 SET VAR1=$GET(^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX))
- +43 SET VAR2=$GET(^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX,"X"))
- +44 SET VAR3=$GET(^TMP("PSB",$JOB,DFN,PSBDT,PSBOITX,PSBONX,.3))
- +45 IF PSBDT["ONE-TIME"
- Begin DoDot:6
- +46 WRITE !,PSBDT,?37,PSBOITX
- SET SP=1
- if PSBCLINORD
- WRITE ?103,PSBCLORD
- +47 IF VAR1]""
- WRITE !,?37,$PIECE(VAR1,U,1)
- SET SP=1
- +48 IF VAR2]""
- if $GET(SP)
- WRITE !
- WRITE ?37,VAR2
- +49 IF VAR3]""
- WRITE !,$$WRAP^PSBO(37,102,VAR3)
- +50 ;DFN added to PSBSTXT array in PSB*3*52
- WRITE !?3,"Start Date/Time: ",?21,$ORDER(PSBSTXT(PSBONX,DFN,""))
- +51 ;DFN added to PSBSTXP array in PSB*3*52
- WRITE !?3,"Stop Date/Time: ",?21,$ORDER(PSBSTXP(PSBONX,DFN,""))
- +52 WRITE !
- End DoDot:6
- QUIT
- +53 ;detail line additional info
- +54 SET SP=1
- +55 IF VAR1]""
- WRITE !,?57,VAR1
- SET SP=1
- +56 IF VAR2]""
- if $GET(SP)
- WRITE !
- WRITE ?57,VAR2
- +57 IF VAR3]""
- WRITE !,$$WRAP^PSBO(57,82,VAR3)
- End DoDot:5
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +58 QUIT
- +59 ;
- CLNHDR() ; *106
- +1 DO CLINIC^PSBOHDR(.PSBRPT,.PSBHDR,,,PSBSRCHL)
- +2 WRITE !,"Order Sts",?11,"Ver",?17,"Patient",?49,"Missed Date/Time",?66,"Medication",?103,"Location"
- +3 DO LN1^PSBOMM2
- +4 QUIT ""