PSBOMV ;BIRMINGHAM/EFC-BCMA UNIT DOSE VIRTUAL DUE LIST FUNCTIONS ;03/06/16 3:06pm
;;3.0;BAR CODE MED ADMIN;**60,78,72,86,83**;Mar 2004;Build 89
;Per VHA Directive 2004-038 (or future revisions regarding same), this routine should not be modified.
;
; Reference/IA
; ^DPT/10035
; ^NURSF(211.4/1409
; ^XLFDT/10103
;
;*83 - add ablility to print Removal of meds variances now.
EN ;
N CNT,PSBHDR,PSBPT,PSBINDX,DFN,PSBY,PSBSORT,PSBPRINT,PSBDT,PSBEV,PSBLOG,PSBPRCX,PSBRB,PSBSTOP,PSBSTRT,PSBTIME,PSBWLF,PSBWRD,PSBWRDA,PSBX,PSBY,PSBXX
;
K ^TMP("PSBO",$J)
S PSBSTRT=$P(PSBRPT(.1),U,6)+$P(PSBRPT(.1),U,7)
S PSBSTOP=$P(PSBRPT(.1),U,8)+$P(PSBRPT(.1),U,9)
S CNT=0,PSBPRINT=$P($G(PSBRPT(.1)),U)
I PSBPRINT="P" S PSBPT=$P(PSBRPT(.1),U,2)
I PSBPRINT="W" S PSBSORT=$P($G(PSBRPT(.1)),U,5),PSBWRD=$P(PSBRPT(.1),U,3) Q:'PSBWRD D WARD^NURSUT5("L^"_PSBWRD,.PSBWRDA)
;
RANGE ;Locate data between date range.
N PSBTMDF
S PSBX=PSBSTRT F S PSBX=$O(^PSB(53.78,"ADT",PSBX)) Q:'PSBX!(PSBX>PSBSTOP) D
.F PSBY=0:0 S PSBY=$O(^PSB(53.78,"ADT",PSBX,PSBY)) Q:'PSBY D
..S DFN=+^PSB(53.78,PSBY,0),PSBWLF=$P($G(^(0)),U,9),PSBTIME=$P($G(^(0)),U,4),PSBLOG=$P($G(^(0)),U,8)
CHECK ..;Ward IEN must exist in Ward Field # 9.
..Q:'$G(PSBWLF)
..Q:'$G(PSBLOG)
..;*83
..; Fix *60 no longer applies, Removals are now tracked by event code
..; & added to the Var Log file similar to how a Give would be.
..; ORDER ADMINISTRATION VARIANCE field (#.14) in file (#53.79), now
..; also contains Variance of Removes. Calculated remove time vs
..; Scheduled remove time and passes in a Removal type event code.
..; see DD 53.79 trigger xrefs.
..;
..;;PSB*3*60 adds code to allow a variance equal to system variable DILOCKTM when checking for removal of a patch
..;;S PSBTMDF=$$FMDIFF^XLFDT($P($G(^PSB(53.79,PSBLOG,0)),U,6),$G(PSBTIME),2) ;PSB*3*60
..;;I PSBTMDF>=-($S($G(DILOCKTM)>0:DILOCKTM,1:3)),PSBTMDF<=$S($G(DILOCKTM)>0:DILOCKTM,1:3),$P($G(^PSB(53.79,PSBLOG,0)),U,9)="RM" Q ;PSB*3*60
..;
..;Quit if Ward IEN is not in Nurse Location file.
..I PSBPRINT="W",'$O(^NURSF(211.4,"C",PSBWLF,PSBWRD,0)) Q
..;Compare date/time and Quit if order status set to Remove.
..;
BUILD ..I $G(PSBSORT)'="B" S ^TMP("PSBO",$J,DFN,PSBX,PSBY)=""
..I PSBPRINT="P",DFN=PSBPT S ^TMP("PSBO",$J,"B",$P(^DPT(DFN,0),U),DFN)="" Q
..S ^TMP("PSBO",$J,DFN,0)=^DPT(DFN,0)
..I PSBPRINT="W" D SORTING
;
BYWDPT ;Print by Ward and Sort by Patient.
I $G(PSBPRINT)="W",$G(PSBSORT)'="B" D
.;Print report by the selected ward name.
.W $$WRDHDR()
.S PSBINDX=""
.F S PSBINDX=$O(^TMP("PSBO",$J,"B",PSBINDX)) Q:PSBINDX="" D
..F DFN=0:0 S DFN=$O(^TMP("PSBO",$J,"B",PSBINDX,DFN)) Q:'DFN D
...W:$Y>(IOSL-10) $$WRDHDR()
...F PSBDT=0:0 S PSBDT=$O(^TMP("PSBO",$J,DFN,PSBDT)) Q:'PSBDT D
....F PSBY=0:0 S PSBY=$O(^TMP("PSBO",$J,DFN,PSBDT,PSBY)) Q:'PSBY D
.....D EVENTS ;Set Total Number of Events
.....S PSBRB=$$GET1^DIQ(53.78,PSBY_",",.02)
.....W !,PSBRB
.....W ?20,$P(^TMP("PSBO",$J,DFN,0),U,1)
.....W ?48,$$GET1^DIQ(53.78,PSBY_",",.04)
.....W ?75,$$GET1^DIQ(53.78,PSBY_",",.05)
.....W ?95,$$GET1^DIQ(53.78,PSBY_",",.06)
.....;W ?102,$$GET1^DIQ(53.78,PSBY_",",.07) - Remove .07 since medication is written through pointer, PSB*3*86
.....W ?102,$$GET1^DIQ(53.78,PSBY_",","MED LOG PTR:ADMINISTRATION MEDICATION")
.....D VCOM ;Print Ward and Comments from Med Log.
.....W !?52
.W !! D EVEPRNT
;
BYWDRB ;Print by Ward and Sort by Room and Bed.
I $G(PSBPRINT)="W",$G(PSBSORT)="B" D
.;Print report by the selected ward name.
.W $$WRDHDR()
.S PSBINDX=""
.F S PSBINDX=$O(^TMP("PSBO",$J,"B",PSBINDX)) Q:PSBINDX="" D
..F DFN=0:0 S DFN=$O(^TMP("PSBO",$J,"B",PSBINDX,DFN)) Q:'DFN D
...W:$Y>(IOSL-10) $$WRDHDR()
...F PSBDT=0:0 S PSBDT=$O(^TMP("PSBO",$J,"B",PSBINDX,DFN,PSBDT)) Q:'PSBDT D
....F PSBY=0:0 S PSBY=$O(^TMP("PSBO",$J,"B",PSBINDX,DFN,PSBDT,PSBY)) Q:'PSBY D
.....D EVENTS ;Set Total Number of Events
.....S PSBRB=$$GET1^DIQ(53.78,PSBY_",",.02)
.....W !,PSBRB
.....W ?20,$P(^TMP("PSBO",$J,DFN,0),U,1)
.....W ?48,$$GET1^DIQ(53.78,PSBY_",",.04)
.....W ?75,$$GET1^DIQ(53.78,PSBY_",",.05)
.....W ?95,$$GET1^DIQ(53.78,PSBY_",",.06)
.....;W ?102,$$GET1^DIQ(53.78,PSBY_",",.07) - Remove .07 since medication is written through pointer, PSB*3*86
.....W ?102,$$GET1^DIQ(53.78,PSBY_",","MED LOG PTR:ADMINISTRATION MEDICATION")
.....D VCOM ;Print Ward and Comments from Med Log.
.....W !?52
.W !! D EVEPRNT
;
BYDFN ;Print by Patient.
D:$G(PSBPRINT)="P"
.W $$PTHDR()
.S PSBINDX=""
.F S PSBINDX=$O(^TMP("PSBO",$J,"B",PSBINDX)) Q:PSBINDX="" D
..F DFN=0:0 S DFN=$O(^TMP("PSBO",$J,"B",PSBINDX,DFN)) Q:'DFN D
...W:$Y>(IOSL-10) $$PTHDR()
...F PSBDT=0:0 S PSBDT=$O(^TMP("PSBO",$J,DFN,PSBDT)) Q:'PSBDT D
....F PSBY=0:0 S PSBY=$O(^TMP("PSBO",$J,DFN,PSBDT,PSBY)) Q:'PSBY D
.....D EVENTS ;Set Total Number of Events
.....W !,$$GET1^DIQ(53.78,PSBY_",",.04)
.....W ?23,$$GET1^DIQ(53.78,PSBY_",",.05)
.....W ?43,$$GET1^DIQ(53.78,PSBY_",",.06)
.....;W ?50,$$GET1^DIQ(53.78,PSBY_",",.07) - Remove .07 since medication is written through pointer, PSB*3*86
.....W ?50,$$GET1^DIQ(53.78,PSBY_",","MED LOG PTR:ADMINISTRATION MEDICATION")
.....D VCOM ;Print Ward and Comments from Med Log.
.W !! D EVEPRNT
.W $$PTFTR^PSBOHDR()
Q
;
WRDHDR() ;
N PSBSRCHL ;Add PSBSRCHL variable and additional PSBHDR array spacers for PSBOHDR call, PSB*3*78
S PSBHDR(1)="MEDICATION VARIANCE LOG for "_$$FMTE^XLFDT(PSBSTRT)_" to "_$$FMTE^XLFDT(PSBSTOP) ;Add time frame for report header, PSB*3*72
S PSBSRCHL=$$SRCHLIST^PSBOHDR()
S PSBHDR(2)="",PSBHDR(3)="",PSBHDR(4)="Ward Location: "
D WARD^PSBOHDR(PSBWRD,.PSBHDR,,,PSBSRCHL)
W !,"Rm-Bed",?20,"Patient Name",?48,"Event Date/Time",?75,"Event",?95,"Var",?102,"Medication",!,$TR($J("",IOM)," ","-")
Q ""
;
PTHDR() ;
S PSBHDR(1)="MEDICATION VARIANCE LOG for "_$$FMTE^XLFDT(PSBSTRT)_" to "_$$FMTE^XLFDT(PSBSTOP) ;Add time frame for report header, PSB*3*72
D PT^PSBOHDR(PSBDFN,.PSBHDR)
W !,"Event Date/Time",?23,"Event",?43,"Var",?50,"Medication",!,$TR($J("",IOM)," ","-")
Q ""
;
VCOM ;Print Ward and Comments from Med Log on Variance Report.
N PSBCOM,PSBML,Y
Q:'$P($G(^PSB(53.78,PSBY,0)),"^",8) S PSBML=$P(^(0),"^",8)
I $P(PSBRPT(.1),U)="P" W !,?23,"Ward: ",?34 D
.I $P($G(^PSB(53.79,PSBML,0)),U,2)="" W "<No Ward>" Q
.W $P($G(^PSB(53.79,PSBML,0)),U,2)
W !,?23,"Comments: ",?34 I '$O(^PSB(53.79,PSBML,.3,0)) W "<No Comments>" I $Y>(IOSL-10) D Q ;correct page breaks, PSB*3*60
.I $G(PSBPRINT)="P" W $$PTFTR^PSBOHDR(),!,$$PTHDR() ;correct page breaks, PSB*3*60
.I $G(PSBPRINT)="W" W !,$$WRDHDR() ;correct page breaks, PSB*3*60
F PSBCOM=0:0 S PSBCOM=$O(^PSB(53.79,PSBML,.3,PSBCOM)) Q:'PSBCOM D
.W:$X>34 !?34
.S Y=$P(^PSB(53.79,PSBML,.3,PSBCOM,0),U,3)+.0000001
.W $E(Y,4,5),"/",$E(Y,6,7),"/",$E(Y,2,3)," ",$E(Y,9,10),":",$E(Y,11,12),?50,"By: ",$$GET1^DIQ(53.793,PSBCOM_","_PSBML_",","ENTERED BY:INITIAL"),$$WRAP^PSBO(60,75,$P(^PSB(53.79,PSBML,.3,PSBCOM,0),U,1))
.I $Y>(IOSL-10) D ;correct page breaks, PSB*3*60
..I $G(PSBPRINT)="P" W $$PTFTR^PSBOHDR(),!,$$PTHDR() ;correct page breaks, PSB*3*60
..I $G(PSBPRINT)="W" W !,$$WRDHDR() ;correct page breaks, PSB*3*60
Q
;
EVENTS ;Record total number of events.
S PSBEV=$P($G(^PSB(53.78,PSBY,0)),U,5) Q:'$G(PSBEV)
S ^TMP("PSBO",$J,"EVENTS",PSBEV,0)=$P($G(^TMP("PSBO",$J,"EVENTS",PSBEV,0)),U)+1
S CNT=CNT+1,^TMP("PSBO",$J,"EVENTSTOT",0)=CNT
Q
EVEPRNT ;Display Total and Percentage of Events.
;
Q:'$D(^TMP("PSBO",$J,"EVENTSTOT")) ;Quit if there are no events
W !,"Total Number of Events for the reporting period is: "_$P(^TMP("PSBO",$J,"EVENTSTOT",0),U)_".",!
F PSBXX=0:0 S PSBXX=$O(^TMP("PSBO",$J,"EVENTS",PSBXX)) Q:'PSBXX D
.W !,"Total number of "_$$EXTERNAL^DILFD(53.78,.05,"",PSBXX)_" events is "_$P($G(^TMP("PSBO",$J,"EVENTS",PSBXX,0)),U)_"."
.S PSBPRCX=$E($FN($P(^TMP("PSBO",$J,"EVENTS",PSBXX,0),U)/$P(^TMP("PSBO",$J,"EVENTSTOT",0),U),"",2),3,4)
.W !,"Percentage of Total Events: "_$S(PSBPRCX="00":"100",1:PSBPRCX)_"%",!
Q
;
SORTING ;Sort by Patient or Room and Bed Information
;
I $G(PSBSORT)="P"!($G(PSBSORT)="") S PSBINDX=$P(^DPT(DFN,0),U),^TMP("PSBO",$J,"B",PSBINDX,DFN)="" Q
I $G(PSBSORT)="B" S PSBINDX=$P($G(^PSB(53.78,+PSBY,0)),U,2) S:PSBINDX="" PSBINDX="** NO ROOM/BED **" S ^TMP("PSBO",$J,"B",PSBINDX,DFN,PSBX,PSBY)=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSBOMV 8429 printed Dec 13, 2024@01:40:47 Page 2
PSBOMV ;BIRMINGHAM/EFC-BCMA UNIT DOSE VIRTUAL DUE LIST FUNCTIONS ;03/06/16 3:06pm
+1 ;;3.0;BAR CODE MED ADMIN;**60,78,72,86,83**;Mar 2004;Build 89
+2 ;Per VHA Directive 2004-038 (or future revisions regarding same), this routine should not be modified.
+3 ;
+4 ; Reference/IA
+5 ; ^DPT/10035
+6 ; ^NURSF(211.4/1409
+7 ; ^XLFDT/10103
+8 ;
+9 ;*83 - add ablility to print Removal of meds variances now.
EN ;
+1 NEW CNT,PSBHDR,PSBPT,PSBINDX,DFN,PSBY,PSBSORT,PSBPRINT,PSBDT,PSBEV,PSBLOG,PSBPRCX,PSBRB,PSBSTOP,PSBSTRT,PSBTIME,PSBWLF,PSBWRD,PSBWRDA,PSBX,PSBY,PSBXX
+2 ;
+3 KILL ^TMP("PSBO",$JOB)
+4 SET PSBSTRT=$PIECE(PSBRPT(.1),U,6)+$PIECE(PSBRPT(.1),U,7)
+5 SET PSBSTOP=$PIECE(PSBRPT(.1),U,8)+$PIECE(PSBRPT(.1),U,9)
+6 SET CNT=0
SET PSBPRINT=$PIECE($GET(PSBRPT(.1)),U)
+7 IF PSBPRINT="P"
SET PSBPT=$PIECE(PSBRPT(.1),U,2)
+8 IF PSBPRINT="W"
SET PSBSORT=$PIECE($GET(PSBRPT(.1)),U,5)
SET PSBWRD=$PIECE(PSBRPT(.1),U,3)
if 'PSBWRD
QUIT
DO WARD^NURSUT5("L^"_PSBWRD,.PSBWRDA)
+9 ;
RANGE ;Locate data between date range.
+1 NEW PSBTMDF
+2 SET PSBX=PSBSTRT
FOR
SET PSBX=$ORDER(^PSB(53.78,"ADT",PSBX))
if 'PSBX!(PSBX>PSBSTOP)
QUIT
Begin DoDot:1
+3 FOR PSBY=0:0
SET PSBY=$ORDER(^PSB(53.78,"ADT",PSBX,PSBY))
if 'PSBY
QUIT
Begin DoDot:2
+4 SET DFN=+^PSB(53.78,PSBY,0)
SET PSBWLF=$PIECE($GET(^(0)),U,9)
SET PSBTIME=$PIECE($GET(^(0)),U,4)
SET PSBLOG=$PIECE($GET(^(0)),U,8)
CHECK ;Ward IEN must exist in Ward Field # 9.
+1 if '$GET(PSBWLF)
QUIT
+2 if '$GET(PSBLOG)
QUIT
+3 ;*83
+4 ; Fix *60 no longer applies, Removals are now tracked by event code
+5 ; & added to the Var Log file similar to how a Give would be.
+6 ; ORDER ADMINISTRATION VARIANCE field (#.14) in file (#53.79), now
+7 ; also contains Variance of Removes. Calculated remove time vs
+8 ; Scheduled remove time and passes in a Removal type event code.
+9 ; see DD 53.79 trigger xrefs.
+10 ;
+11 ;;PSB*3*60 adds code to allow a variance equal to system variable DILOCKTM when checking for removal of a patch
+12 ;;S PSBTMDF=$$FMDIFF^XLFDT($P($G(^PSB(53.79,PSBLOG,0)),U,6),$G(PSBTIME),2) ;PSB*3*60
+13 ;;I PSBTMDF>=-($S($G(DILOCKTM)>0:DILOCKTM,1:3)),PSBTMDF<=$S($G(DILOCKTM)>0:DILOCKTM,1:3),$P($G(^PSB(53.79,PSBLOG,0)),U,9)="RM" Q ;PSB*3*60
+14 ;
+15 ;Quit if Ward IEN is not in Nurse Location file.
+16 IF PSBPRINT="W"
IF '$ORDER(^NURSF(211.4,"C",PSBWLF,PSBWRD,0))
QUIT
+17 ;Compare date/time and Quit if order status set to Remove.
+18 ;
BUILD IF $GET(PSBSORT)'="B"
SET ^TMP("PSBO",$JOB,DFN,PSBX,PSBY)=""
+1 IF PSBPRINT="P"
IF DFN=PSBPT
SET ^TMP("PSBO",$JOB,"B",$PIECE(^DPT(DFN,0),U),DFN)=""
QUIT
+2 SET ^TMP("PSBO",$JOB,DFN,0)=^DPT(DFN,0)
+3 IF PSBPRINT="W"
DO SORTING
End DoDot:2
End DoDot:1
+4 ;
BYWDPT ;Print by Ward and Sort by Patient.
+1 IF $GET(PSBPRINT)="W"
IF $GET(PSBSORT)'="B"
Begin DoDot:1
+2 ;Print report by the selected ward name.
+3 WRITE $$WRDHDR()
+4 SET PSBINDX=""
+5 FOR
SET PSBINDX=$ORDER(^TMP("PSBO",$JOB,"B",PSBINDX))
if PSBINDX=""
QUIT
Begin DoDot:2
+6 FOR DFN=0:0
SET DFN=$ORDER(^TMP("PSBO",$JOB,"B",PSBINDX,DFN))
if 'DFN
QUIT
Begin DoDot:3
+7 if $Y>(IOSL-10)
WRITE $$WRDHDR()
+8 FOR PSBDT=0:0
SET PSBDT=$ORDER(^TMP("PSBO",$JOB,DFN,PSBDT))
if 'PSBDT
QUIT
Begin DoDot:4
+9 FOR PSBY=0:0
SET PSBY=$ORDER(^TMP("PSBO",$JOB,DFN,PSBDT,PSBY))
if 'PSBY
QUIT
Begin DoDot:5
+10 ;Set Total Number of Events
DO EVENTS
+11 SET PSBRB=$$GET1^DIQ(53.78,PSBY_",",.02)
+12 WRITE !,PSBRB
+13 WRITE ?20,$PIECE(^TMP("PSBO",$JOB,DFN,0),U,1)
+14 WRITE ?48,$$GET1^DIQ(53.78,PSBY_",",.04)
+15 WRITE ?75,$$GET1^DIQ(53.78,PSBY_",",.05)
+16 WRITE ?95,$$GET1^DIQ(53.78,PSBY_",",.06)
+17 ;W ?102,$$GET1^DIQ(53.78,PSBY_",",.07) - Remove .07 since medication is written through pointer, PSB*3*86
+18 WRITE ?102,$$GET1^DIQ(53.78,PSBY_",","MED LOG PTR:ADMINISTRATION MEDICATION")
+19 ;Print Ward and Comments from Med Log.
DO VCOM
+20 WRITE !?52
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
+21 WRITE !!
DO EVEPRNT
End DoDot:1
+22 ;
BYWDRB ;Print by Ward and Sort by Room and Bed.
+1 IF $GET(PSBPRINT)="W"
IF $GET(PSBSORT)="B"
Begin DoDot:1
+2 ;Print report by the selected ward name.
+3 WRITE $$WRDHDR()
+4 SET PSBINDX=""
+5 FOR
SET PSBINDX=$ORDER(^TMP("PSBO",$JOB,"B",PSBINDX))
if PSBINDX=""
QUIT
Begin DoDot:2
+6 FOR DFN=0:0
SET DFN=$ORDER(^TMP("PSBO",$JOB,"B",PSBINDX,DFN))
if 'DFN
QUIT
Begin DoDot:3
+7 if $Y>(IOSL-10)
WRITE $$WRDHDR()
+8 FOR PSBDT=0:0
SET PSBDT=$ORDER(^TMP("PSBO",$JOB,"B",PSBINDX,DFN,PSBDT))
if 'PSBDT
QUIT
Begin DoDot:4
+9 FOR PSBY=0:0
SET PSBY=$ORDER(^TMP("PSBO",$JOB,"B",PSBINDX,DFN,PSBDT,PSBY))
if 'PSBY
QUIT
Begin DoDot:5
+10 ;Set Total Number of Events
DO EVENTS
+11 SET PSBRB=$$GET1^DIQ(53.78,PSBY_",",.02)
+12 WRITE !,PSBRB
+13 WRITE ?20,$PIECE(^TMP("PSBO",$JOB,DFN,0),U,1)
+14 WRITE ?48,$$GET1^DIQ(53.78,PSBY_",",.04)
+15 WRITE ?75,$$GET1^DIQ(53.78,PSBY_",",.05)
+16 WRITE ?95,$$GET1^DIQ(53.78,PSBY_",",.06)
+17 ;W ?102,$$GET1^DIQ(53.78,PSBY_",",.07) - Remove .07 since medication is written through pointer, PSB*3*86
+18 WRITE ?102,$$GET1^DIQ(53.78,PSBY_",","MED LOG PTR:ADMINISTRATION MEDICATION")
+19 ;Print Ward and Comments from Med Log.
DO VCOM
+20 WRITE !?52
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
+21 WRITE !!
DO EVEPRNT
End DoDot:1
+22 ;
BYDFN ;Print by Patient.
+1 if $GET(PSBPRINT)="P"
Begin DoDot:1
+2 WRITE $$PTHDR()
+3 SET PSBINDX=""
+4 FOR
SET PSBINDX=$ORDER(^TMP("PSBO",$JOB,"B",PSBINDX))
if PSBINDX=""
QUIT
Begin DoDot:2
+5 FOR DFN=0:0
SET DFN=$ORDER(^TMP("PSBO",$JOB,"B",PSBINDX,DFN))
if 'DFN
QUIT
Begin DoDot:3
+6 if $Y>(IOSL-10)
WRITE $$PTHDR()
+7 FOR PSBDT=0:0
SET PSBDT=$ORDER(^TMP("PSBO",$JOB,DFN,PSBDT))
if 'PSBDT
QUIT
Begin DoDot:4
+8 FOR PSBY=0:0
SET PSBY=$ORDER(^TMP("PSBO",$JOB,DFN,PSBDT,PSBY))
if 'PSBY
QUIT
Begin DoDot:5
+9 ;Set Total Number of Events
DO EVENTS
+10 WRITE !,$$GET1^DIQ(53.78,PSBY_",",.04)
+11 WRITE ?23,$$GET1^DIQ(53.78,PSBY_",",.05)
+12 WRITE ?43,$$GET1^DIQ(53.78,PSBY_",",.06)
+13 ;W ?50,$$GET1^DIQ(53.78,PSBY_",",.07) - Remove .07 since medication is written through pointer, PSB*3*86
+14 WRITE ?50,$$GET1^DIQ(53.78,PSBY_",","MED LOG PTR:ADMINISTRATION MEDICATION")
+15 ;Print Ward and Comments from Med Log.
DO VCOM
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
+16 WRITE !!
DO EVEPRNT
+17 WRITE $$PTFTR^PSBOHDR()
End DoDot:1
+18 QUIT
+19 ;
WRDHDR() ;
+1 ;Add PSBSRCHL variable and additional PSBHDR array spacers for PSBOHDR call, PSB*3*78
NEW PSBSRCHL
+2 ;Add time frame for report header, PSB*3*72
SET PSBHDR(1)="MEDICATION VARIANCE LOG for "_$$FMTE^XLFDT(PSBSTRT)_" to "_$$FMTE^XLFDT(PSBSTOP)
+3 SET PSBSRCHL=$$SRCHLIST^PSBOHDR()
+4 SET PSBHDR(2)=""
SET PSBHDR(3)=""
SET PSBHDR(4)="Ward Location: "
+5 DO WARD^PSBOHDR(PSBWRD,.PSBHDR,,,PSBSRCHL)
+6 WRITE !,"Rm-Bed",?20,"Patient Name",?48,"Event Date/Time",?75,"Event",?95,"Var",?102,"Medication",!,$TRANSLATE($JUSTIFY("",IOM)," ","-")
+7 QUIT ""
+8 ;
PTHDR() ;
+1 ;Add time frame for report header, PSB*3*72
SET PSBHDR(1)="MEDICATION VARIANCE LOG for "_$$FMTE^XLFDT(PSBSTRT)_" to "_$$FMTE^XLFDT(PSBSTOP)
+2 DO PT^PSBOHDR(PSBDFN,.PSBHDR)
+3 WRITE !,"Event Date/Time",?23,"Event",?43,"Var",?50,"Medication",!,$TRANSLATE($JUSTIFY("",IOM)," ","-")
+4 QUIT ""
+5 ;
VCOM ;Print Ward and Comments from Med Log on Variance Report.
+1 NEW PSBCOM,PSBML,Y
+2 if '$PIECE($GET(^PSB(53.78,PSBY,0)),"^",8)
QUIT
SET PSBML=$PIECE(^(0),"^",8)
+3 IF $PIECE(PSBRPT(.1),U)="P"
WRITE !,?23,"Ward: ",?34
Begin DoDot:1
+4 IF $PIECE($GET(^PSB(53.79,PSBML,0)),U,2)=""
WRITE "<No Ward>"
QUIT
+5 WRITE $PIECE($GET(^PSB(53.79,PSBML,0)),U,2)
End DoDot:1
+6 ;correct page breaks, PSB*3*60
WRITE !,?23,"Comments: ",?34
IF '$ORDER(^PSB(53.79,PSBML,.3,0))
WRITE "<No Comments>"
IF $Y>(IOSL-10)
Begin DoDot:1
+7 ;correct page breaks, PSB*3*60
IF $GET(PSBPRINT)="P"
WRITE $$PTFTR^PSBOHDR(),!,$$PTHDR()
+8 ;correct page breaks, PSB*3*60
IF $GET(PSBPRINT)="W"
WRITE !,$$WRDHDR()
End DoDot:1
QUIT
+9 FOR PSBCOM=0:0
SET PSBCOM=$ORDER(^PSB(53.79,PSBML,.3,PSBCOM))
if 'PSBCOM
QUIT
Begin DoDot:1
+10 if $X>34
WRITE !?34
+11 SET Y=$PIECE(^PSB(53.79,PSBML,.3,PSBCOM,0),U,3)+.0000001
+12 WRITE $EXTRACT(Y,4,5),"/",$EXTRACT(Y,6,7),"/",$EXTRACT(Y,2,3)," ",$EXTRACT(Y,9,10),":",$EXTRACT(Y,11,12),?50,"By: ",$$GET1^DIQ(53.793,PSBCOM_","_PSBML_",","ENTERED BY:INITIAL"),$$WRAP^PSBO(60,75,$PIECE(^PSB(53.79,PSBML,.3,PSBCOM,0),U,1)
)
+13 ;correct page breaks, PSB*3*60
IF $Y>(IOSL-10)
Begin DoDot:2
+14 ;correct page breaks, PSB*3*60
IF $GET(PSBPRINT)="P"
WRITE $$PTFTR^PSBOHDR(),!,$$PTHDR()
+15 ;correct page breaks, PSB*3*60
IF $GET(PSBPRINT)="W"
WRITE !,$$WRDHDR()
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;
EVENTS ;Record total number of events.
+1 SET PSBEV=$PIECE($GET(^PSB(53.78,PSBY,0)),U,5)
if '$GET(PSBEV)
QUIT
+2 SET ^TMP("PSBO",$JOB,"EVENTS",PSBEV,0)=$PIECE($GET(^TMP("PSBO",$JOB,"EVENTS",PSBEV,0)),U)+1
+3 SET CNT=CNT+1
SET ^TMP("PSBO",$JOB,"EVENTSTOT",0)=CNT
+4 QUIT
EVEPRNT ;Display Total and Percentage of Events.
+1 ;
+2 ;Quit if there are no events
if '$DATA(^TMP("PSBO",$JOB,"EVENTSTOT"))
QUIT
+3 WRITE !,"Total Number of Events for the reporting period is: "_$PIECE(^TMP("PSBO",$JOB,"EVENTSTOT",0),U)_".",!
+4 FOR PSBXX=0:0
SET PSBXX=$ORDER(^TMP("PSBO",$JOB,"EVENTS",PSBXX))
if 'PSBXX
QUIT
Begin DoDot:1
+5 WRITE !,"Total number of "_$$EXTERNAL^DILFD(53.78,.05,"",PSBXX)_" events is "_$PIECE($GET(^TMP("PSBO",$JOB,"EVENTS",PSBXX,0)),U)_"."
+6 SET PSBPRCX=$EXTRACT($FNUMBER($PIECE(^TMP("PSBO",$JOB,"EVENTS",PSBXX,0),U)/$PIECE(^TMP("PSBO",$JOB,"EVENTSTOT",0),U),"",2),3,4)
+7 WRITE !,"Percentage of Total Events: "_$SELECT(PSBPRCX="00":"100",1:PSBPRCX)_"%",!
End DoDot:1
+8 QUIT
+9 ;
SORTING ;Sort by Patient or Room and Bed Information
+1 ;
+2 IF $GET(PSBSORT)="P"!($GET(PSBSORT)="")
SET PSBINDX=$PIECE(^DPT(DFN,0),U)
SET ^TMP("PSBO",$JOB,"B",PSBINDX,DFN)=""
QUIT
+3 IF $GET(PSBSORT)="B"
SET PSBINDX=$PIECE($GET(^PSB(53.78,+PSBY,0)),U,2)
if PSBINDX=""
SET PSBINDX="** NO ROOM/BED **"
SET ^TMP("PSBO",$JOB,"B",PSBINDX,DFN,PSBX,PSBY)=""
+4 QUIT
