- 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 Jan 18, 2025@02:42:01 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