Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSBOMV

PSBOMV.m

Go to the documentation of this file.
  1. 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
  1. ;Per VHA Directive 2004-038 (or future revisions regarding same), this routine should not be modified.
  1. ;
  1. ; Reference/IA
  1. ; ^DPT/10035
  1. ; ^NURSF(211.4/1409
  1. ; ^XLFDT/10103
  1. ;
  1. ;*83 - add ablility to print Removal of meds variances now.
  1. EN ;
  1. N CNT,PSBHDR,PSBPT,PSBINDX,DFN,PSBY,PSBSORT,PSBPRINT,PSBDT,PSBEV,PSBLOG,PSBPRCX,PSBRB,PSBSTOP,PSBSTRT,PSBTIME,PSBWLF,PSBWRD,PSBWRDA,PSBX,PSBY,PSBXX
  1. ;
  1. K ^TMP("PSBO",$J)
  1. S PSBSTRT=$P(PSBRPT(.1),U,6)+$P(PSBRPT(.1),U,7)
  1. S PSBSTOP=$P(PSBRPT(.1),U,8)+$P(PSBRPT(.1),U,9)
  1. S CNT=0,PSBPRINT=$P($G(PSBRPT(.1)),U)
  1. I PSBPRINT="P" S PSBPT=$P(PSBRPT(.1),U,2)
  1. 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)
  1. ;
  1. RANGE ;Locate data between date range.
  1. N PSBTMDF
  1. S PSBX=PSBSTRT F S PSBX=$O(^PSB(53.78,"ADT",PSBX)) Q:'PSBX!(PSBX>PSBSTOP) D
  1. .F PSBY=0:0 S PSBY=$O(^PSB(53.78,"ADT",PSBX,PSBY)) Q:'PSBY D
  1. ..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)
  1. CHECK ..;Ward IEN must exist in Ward Field # 9.
  1. ..Q:'$G(PSBWLF)
  1. ..Q:'$G(PSBLOG)
  1. ..;*83
  1. ..; Fix *60 no longer applies, Removals are now tracked by event code
  1. ..; & added to the Var Log file similar to how a Give would be.
  1. ..; ORDER ADMINISTRATION VARIANCE field (#.14) in file (#53.79), now
  1. ..; also contains Variance of Removes. Calculated remove time vs
  1. ..; Scheduled remove time and passes in a Removal type event code.
  1. ..; see DD 53.79 trigger xrefs.
  1. ..;
  1. ..;;PSB*3*60 adds code to allow a variance equal to system variable DILOCKTM when checking for removal of a patch
  1. ..;;S PSBTMDF=$$FMDIFF^XLFDT($P($G(^PSB(53.79,PSBLOG,0)),U,6),$G(PSBTIME),2) ;PSB*3*60
  1. ..;;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
  1. ..;
  1. ..;Quit if Ward IEN is not in Nurse Location file.
  1. ..I PSBPRINT="W",'$O(^NURSF(211.4,"C",PSBWLF,PSBWRD,0)) Q
  1. ..;Compare date/time and Quit if order status set to Remove.
  1. ..;
  1. BUILD ..I $G(PSBSORT)'="B" S ^TMP("PSBO",$J,DFN,PSBX,PSBY)=""
  1. ..I PSBPRINT="P",DFN=PSBPT S ^TMP("PSBO",$J,"B",$P(^DPT(DFN,0),U),DFN)="" Q
  1. ..S ^TMP("PSBO",$J,DFN,0)=^DPT(DFN,0)
  1. ..I PSBPRINT="W" D SORTING
  1. ;
  1. BYWDPT ;Print by Ward and Sort by Patient.
  1. I $G(PSBPRINT)="W",$G(PSBSORT)'="B" D
  1. .;Print report by the selected ward name.
  1. .W $$WRDHDR()
  1. .S PSBINDX=""
  1. .F S PSBINDX=$O(^TMP("PSBO",$J,"B",PSBINDX)) Q:PSBINDX="" D
  1. ..F DFN=0:0 S DFN=$O(^TMP("PSBO",$J,"B",PSBINDX,DFN)) Q:'DFN D
  1. ...W:$Y>(IOSL-10) $$WRDHDR()
  1. ...F PSBDT=0:0 S PSBDT=$O(^TMP("PSBO",$J,DFN,PSBDT)) Q:'PSBDT D
  1. ....F PSBY=0:0 S PSBY=$O(^TMP("PSBO",$J,DFN,PSBDT,PSBY)) Q:'PSBY D
  1. .....D EVENTS ;Set Total Number of Events
  1. .....S PSBRB=$$GET1^DIQ(53.78,PSBY_",",.02)
  1. .....W !,PSBRB
  1. .....W ?20,$P(^TMP("PSBO",$J,DFN,0),U,1)
  1. .....W ?48,$$GET1^DIQ(53.78,PSBY_",",.04)
  1. .....W ?75,$$GET1^DIQ(53.78,PSBY_",",.05)
  1. .....W ?95,$$GET1^DIQ(53.78,PSBY_",",.06)
  1. .....;W ?102,$$GET1^DIQ(53.78,PSBY_",",.07) - Remove .07 since medication is written through pointer, PSB*3*86
  1. .....W ?102,$$GET1^DIQ(53.78,PSBY_",","MED LOG PTR:ADMINISTRATION MEDICATION")
  1. .....D VCOM ;Print Ward and Comments from Med Log.
  1. .....W !?52
  1. .W !! D EVEPRNT
  1. ;
  1. BYWDRB ;Print by Ward and Sort by Room and Bed.
  1. I $G(PSBPRINT)="W",$G(PSBSORT)="B" D
  1. .;Print report by the selected ward name.
  1. .W $$WRDHDR()
  1. .S PSBINDX=""
  1. .F S PSBINDX=$O(^TMP("PSBO",$J,"B",PSBINDX)) Q:PSBINDX="" D
  1. ..F DFN=0:0 S DFN=$O(^TMP("PSBO",$J,"B",PSBINDX,DFN)) Q:'DFN D
  1. ...W:$Y>(IOSL-10) $$WRDHDR()
  1. ...F PSBDT=0:0 S PSBDT=$O(^TMP("PSBO",$J,"B",PSBINDX,DFN,PSBDT)) Q:'PSBDT D
  1. ....F PSBY=0:0 S PSBY=$O(^TMP("PSBO",$J,"B",PSBINDX,DFN,PSBDT,PSBY)) Q:'PSBY D
  1. .....D EVENTS ;Set Total Number of Events
  1. .....S PSBRB=$$GET1^DIQ(53.78,PSBY_",",.02)
  1. .....W !,PSBRB
  1. .....W ?20,$P(^TMP("PSBO",$J,DFN,0),U,1)
  1. .....W ?48,$$GET1^DIQ(53.78,PSBY_",",.04)
  1. .....W ?75,$$GET1^DIQ(53.78,PSBY_",",.05)
  1. .....W ?95,$$GET1^DIQ(53.78,PSBY_",",.06)
  1. .....;W ?102,$$GET1^DIQ(53.78,PSBY_",",.07) - Remove .07 since medication is written through pointer, PSB*3*86
  1. .....W ?102,$$GET1^DIQ(53.78,PSBY_",","MED LOG PTR:ADMINISTRATION MEDICATION")
  1. .....D VCOM ;Print Ward and Comments from Med Log.
  1. .....W !?52
  1. .W !! D EVEPRNT
  1. ;
  1. BYDFN ;Print by Patient.
  1. D:$G(PSBPRINT)="P"
  1. .W $$PTHDR()
  1. .S PSBINDX=""
  1. .F S PSBINDX=$O(^TMP("PSBO",$J,"B",PSBINDX)) Q:PSBINDX="" D
  1. ..F DFN=0:0 S DFN=$O(^TMP("PSBO",$J,"B",PSBINDX,DFN)) Q:'DFN D
  1. ...W:$Y>(IOSL-10) $$PTHDR()
  1. ...F PSBDT=0:0 S PSBDT=$O(^TMP("PSBO",$J,DFN,PSBDT)) Q:'PSBDT D
  1. ....F PSBY=0:0 S PSBY=$O(^TMP("PSBO",$J,DFN,PSBDT,PSBY)) Q:'PSBY D
  1. .....D EVENTS ;Set Total Number of Events
  1. .....W !,$$GET1^DIQ(53.78,PSBY_",",.04)
  1. .....W ?23,$$GET1^DIQ(53.78,PSBY_",",.05)
  1. .....W ?43,$$GET1^DIQ(53.78,PSBY_",",.06)
  1. .....;W ?50,$$GET1^DIQ(53.78,PSBY_",",.07) - Remove .07 since medication is written through pointer, PSB*3*86
  1. .....W ?50,$$GET1^DIQ(53.78,PSBY_",","MED LOG PTR:ADMINISTRATION MEDICATION")
  1. .....D VCOM ;Print Ward and Comments from Med Log.
  1. .W !! D EVEPRNT
  1. .W $$PTFTR^PSBOHDR()
  1. Q
  1. ;
  1. WRDHDR() ;
  1. N PSBSRCHL ;Add PSBSRCHL variable and additional PSBHDR array spacers for PSBOHDR call, PSB*3*78
  1. S PSBHDR(1)="MEDICATION VARIANCE LOG for "_$$FMTE^XLFDT(PSBSTRT)_" to "_$$FMTE^XLFDT(PSBSTOP) ;Add time frame for report header, PSB*3*72
  1. S PSBSRCHL=$$SRCHLIST^PSBOHDR()
  1. S PSBHDR(2)="",PSBHDR(3)="",PSBHDR(4)="Ward Location: "
  1. D WARD^PSBOHDR(PSBWRD,.PSBHDR,,,PSBSRCHL)
  1. W !,"Rm-Bed",?20,"Patient Name",?48,"Event Date/Time",?75,"Event",?95,"Var",?102,"Medication",!,$TR($J("",IOM)," ","-")
  1. Q ""
  1. ;
  1. PTHDR() ;
  1. S PSBHDR(1)="MEDICATION VARIANCE LOG for "_$$FMTE^XLFDT(PSBSTRT)_" to "_$$FMTE^XLFDT(PSBSTOP) ;Add time frame for report header, PSB*3*72
  1. D PT^PSBOHDR(PSBDFN,.PSBHDR)
  1. W !,"Event Date/Time",?23,"Event",?43,"Var",?50,"Medication",!,$TR($J("",IOM)," ","-")
  1. Q ""
  1. ;
  1. VCOM ;Print Ward and Comments from Med Log on Variance Report.
  1. N PSBCOM,PSBML,Y
  1. Q:'$P($G(^PSB(53.78,PSBY,0)),"^",8) S PSBML=$P(^(0),"^",8)
  1. I $P(PSBRPT(.1),U)="P" W !,?23,"Ward: ",?34 D
  1. .I $P($G(^PSB(53.79,PSBML,0)),U,2)="" W "<No Ward>" Q
  1. .W $P($G(^PSB(53.79,PSBML,0)),U,2)
  1. 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
  1. .I $G(PSBPRINT)="P" W $$PTFTR^PSBOHDR(),!,$$PTHDR() ;correct page breaks, PSB*3*60
  1. .I $G(PSBPRINT)="W" W !,$$WRDHDR() ;correct page breaks, PSB*3*60
  1. F PSBCOM=0:0 S PSBCOM=$O(^PSB(53.79,PSBML,.3,PSBCOM)) Q:'PSBCOM D
  1. .W:$X>34 !?34
  1. .S Y=$P(^PSB(53.79,PSBML,.3,PSBCOM,0),U,3)+.0000001
  1. .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))
  1. .I $Y>(IOSL-10) D ;correct page breaks, PSB*3*60
  1. ..I $G(PSBPRINT)="P" W $$PTFTR^PSBOHDR(),!,$$PTHDR() ;correct page breaks, PSB*3*60
  1. ..I $G(PSBPRINT)="W" W !,$$WRDHDR() ;correct page breaks, PSB*3*60
  1. Q
  1. ;
  1. EVENTS ;Record total number of events.
  1. S PSBEV=$P($G(^PSB(53.78,PSBY,0)),U,5) Q:'$G(PSBEV)
  1. S ^TMP("PSBO",$J,"EVENTS",PSBEV,0)=$P($G(^TMP("PSBO",$J,"EVENTS",PSBEV,0)),U)+1
  1. S CNT=CNT+1,^TMP("PSBO",$J,"EVENTSTOT",0)=CNT
  1. Q
  1. EVEPRNT ;Display Total and Percentage of Events.
  1. ;
  1. Q:'$D(^TMP("PSBO",$J,"EVENTSTOT")) ;Quit if there are no events
  1. W !,"Total Number of Events for the reporting period is: "_$P(^TMP("PSBO",$J,"EVENTSTOT",0),U)_".",!
  1. F PSBXX=0:0 S PSBXX=$O(^TMP("PSBO",$J,"EVENTS",PSBXX)) Q:'PSBXX D
  1. .W !,"Total number of "_$$EXTERNAL^DILFD(53.78,.05,"",PSBXX)_" events is "_$P($G(^TMP("PSBO",$J,"EVENTS",PSBXX,0)),U)_"."
  1. .S PSBPRCX=$E($FN($P(^TMP("PSBO",$J,"EVENTS",PSBXX,0),U)/$P(^TMP("PSBO",$J,"EVENTSTOT",0),U),"",2),3,4)
  1. .W !,"Percentage of Total Events: "_$S(PSBPRCX="00":"100",1:PSBPRCX)_"%",!
  1. Q
  1. ;
  1. SORTING ;Sort by Patient or Room and Bed Information
  1. ;
  1. I $G(PSBSORT)="P"!($G(PSBSORT)="") S PSBINDX=$P(^DPT(DFN,0),U),^TMP("PSBO",$J,"B",PSBINDX,DFN)="" Q
  1. 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)=""
  1. Q