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

PSBOML.m

Go to the documentation of this file.
  1. PSBOML ;BIRMINGHAM/EFC - MEDICATION LOG ;Sep 09, 2020@14:17:51
  1. ;;3.0;BAR CODE MED ADMIN;**3,11,50,54,70,72,83,82**;Mar 2004;Build 27
  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. ; SENDMSG^XMXAPI/2729
  1. ; ^XLFDT/10103
  1. ;
  1. ;*70 - Add Witness for High Risk Drug to report
  1. ; - print Clinic name with each order that occurred in a clinic
  1. ; - set psbclinord=2 for dual hdr text
  1. ; - create var for Search list and use for both IM & CO, pass to
  1. ; PSBOHDR api
  1. ; - 1489: Blended PSB*3*54 with PSB*3*70
  1. ;*83 - Add MRR meds remove times to report.
  1. ;
  1. EN ; Begin printing
  1. N PSBSTRT,PSBSTOP,PSBHDR,DFN,PSBSORT,PSBSRCHL,PSBTMPG,PSBAUDF,PSBGBL
  1. S PSBSORT=$P(PSBRPT(.1),U,1) ;*70
  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 PSBAUDF=$P(PSBRPT(.2),U,9)
  1. S PSBHDR(0)="Medication Log Report for "_$$FMTE^XLFDT(PSBSTRT)_" to "_$$FMTE^XLFDT(PSBSTOP) ;Add time frame for report header, PSB*3*72
  1. S PSBHDR(1)="Continuing/PRN/Stat/One Time Medication/Treatment Record (Detailed Log) (VAF 10-2970 B, C, D)"
  1. ;check Clinic or Nurs Unit search list *70
  1. S PSBSRCHL=$$SRCHLIST^PSBOHDR()
  1. ;
  1. ; Patient Report
  1. ;
  1. D:PSBSORT="P"
  1. .S PSBHDR(2)="Log Type: INDIVIDUAL PATIENT"
  1. .S DFN=+$P(PSBRPT(.1),U,2)
  1. .W $$PTHDR()
  1. .S X=$O(^PSB(53.79,"AADT",DFN,PSBSTRT-.0000001))
  1. .I X>PSBSTOP!(X="") W !!?10,"<<<< NO MEDICATIONS FOUND FOR THIS TIME FRAME >>>>",!! Q
  1. .S PSBGBL=$NAME(^PSB(53.79,"AADT",DFN,PSBSTRT-.0000001))
  1. .F S PSBGBL=$Q(@PSBGBL) Q:PSBGBL="" Q:$QS(PSBGBL,2)'="AADT"!($QS(PSBGBL,3)'=DFN)!($QS(PSBGBL,4)>PSBSTOP) D
  1. ..S PSBIEN=$QS(PSBGBL,5) Q:'$D(^PSB(53.79,PSBIEN))
  1. ..I $P(^PSB(53.79,PSBIEN,0),U,6)'=$QS(PSBGBL,4) Q
  1. ..I $Y>(IOSL-10) W $$PTFTR^PSBOHDR(),$$PTHDR()
  1. ..W $$LINE(PSBIEN)
  1. .W $$PTFTR^PSBOHDR()
  1. ;
  1. ; Ward Output
  1. ;
  1. D:PSBSORT="W"
  1. .S PSBHDR(2)="LOG TYPE: WARD"
  1. .W $$WDHDR(PSBWRD)
  1. .S PSBTMPG=$NAME(^TMP("PSBO",$J,"B"))
  1. .F S PSBTMPG=$Q(@PSBTMPG) Q:PSBTMPG="" Q:$QS(PSBTMPG,1)'="PSBO"!($QS(PSBTMPG,2)'=$J) D
  1. ..S DFN=$QS(PSBTMPG,5)
  1. ..I $Y>(IOSL-14) W $$WDHDR(PSBWRD)
  1. ..W !,$P(^DPT(DFN,0),U)," (",$P(^(0),U,9),")"
  1. ..W !,"Ward: ",$G(^DPT(DFN,.1),"***")," Rm-Bed: ",$G(^DPT(DFN,.101),"***"),!
  1. ..S X=$O(^PSB(53.79,"AADT",DFN,PSBSTRT-.0000001))
  1. ..I X>PSBSTOP!(X="") W !!?10,"<<<< NO MEDICATIONS FOUND FOR THIS TIME FRAME >>>>",!! Q
  1. ..S PSBGBL=$NAME(^PSB(53.79,"AADT",DFN,PSBSTRT-.0000001))
  1. ..F S PSBGBL=$Q(@PSBGBL) Q:PSBGBL="" Q:$QS(PSBGBL,2)'="AADT"!($QS(PSBGBL,3)'=DFN)!($QS(PSBGBL,4)>PSBSTOP) D
  1. ...S PSBIEN=$QS(PSBGBL,5) I $P(^PSB(53.79,PSBIEN,0),U,6)'=$QS(PSBGBL,4) Q
  1. ...W:$Y>(IOSL-10) $$WDHDR(PSBWRD)
  1. ...W $$LINE(PSBIEN)
  1. Q
  1. ;
  1. LINE(PSBIEN) ; Displays the med log entry in PSBIEN
  1. N PSBX,PSBASTUS,PSBMME,PSBEXIST,PSBY,PSBZ,PSBDHIT
  1. S X=$P($G(^PSB(53.79,PSBIEN,.1)),U)
  1. I X="" W !,"Error: Med Log Entry ",PSBIEN," has no order reference number!" Q ""
  1. I 'PSBAUDF,$P(^PSB(53.79,PSBIEN,0),U,9)="N" Q ""
  1. D CLEAN^PSBVT
  1. D PSJ1^PSBVT(DFN,X,,.PSBEXIST)
  1. ; ;[*70-1489]...start
  1. I '$G(PSBEXIST),($G(PSBSCRT)="-1") D ;send email to BCMA UKNOWN ACTIONS group if order given in BCMA does not have a corresponding # 55 file entry
  1. .N XMDUZ,XMSUB,XMTEXT,XMY,PSBERR,PSBPARAM,PSBMG
  1. .S XMSUB="Order given in BCMA does not exist in Pharmacy Patient file"
  1. .S XMDUZ=DUZ
  1. .S XMTEXT="PSBERR"
  1. .S PSBMG=$$GET^XPAR("DIV","PSB MG ADMIN ERROR",,"E"),PSBMG="G."_PSBMG
  1. .S XMY(PSBMG)=""
  1. .S PSBERR(1)="Order #"_$G(PSBIEN)_" given in BCMA no longer has"
  1. .S PSBERR(2)="a corresponding entry in the Pharmacy Patient (#55) file."
  1. .S PSBERR(3)="Please submit a remedy ticket for this issue."
  1. .D SENDMSG^XMXAPI(XMDUZ,XMSUB,XMTEXT,.XMY)
  1. .Q
  1. ; ;[*70-1489]...end
  1. I PSBDFN="-1" W !,"Error: Inpatient Meds API Failure!" Q ""
  1. M PSBX=^PSB(53.79,PSBIEN)
  1. S Y=$P(PSBX(0),U,4)+.0000001
  1. ;*70 print location name per each clinic order
  1. S PSBMME=$$MME(+$G(PSBIEN)) I $G(PSBMME),($TR($P(PSBX(0),U,2)," ","")="") S $P(PSBX(0),U,2)="MME/UNKNOWN LOCATION"
  1. W:$P(PSBX(0),U,2)]"" !,?3,$P(PSBX(0),U,2)
  1. W !,$E(Y,4,5),"/",$E(Y,6,7),"/",$E(Y,2,3)
  1. W " ",$E(Y,9,10),":",$E(Y,11,12)
  1. S Y=$$GET1^DIQ(53.79,PSBIEN_",",.08)
  1. S Y=Y_" ["_$G(PSBDOSE)_$G(PSBIFR)_" "_$G(PSBSCH) ;[*70-1489]
  1. S Y=Y_" "_$G(PSBMRAB) ;[*70-1489]
  1. I $P($G(^PSB(53.79,PSBIEN,.1)),U,8)]"" D ;Inj or Derm site info *83
  1. .S Y=Y_" Derm Site: "_$P(^(.1),U,8)
  1. E D
  1. .S:$P(^(.1),U,6)]"" Y=Y_" Inj Site: "_$P(^(.1),U,6)
  1. ;
  1. S Y=Y_"]"
  1. W $$WRAP^PSBO(16,32,Y)
  1. W ?50,$$GETINIT^PSBCSUTX(PSBIEN,"I") ;Get initials of who took action, PSB*3*72
  1. S X=$P(PSBX(0),U,9)
  1. S PSBASTUS=$S(X="G":"Given",X="H":"Held",X="R":"Refused",X="I":"Infusing",X="C":"Completed",X="S":"Stopped",X="N":"Not Given",X="RM":"Removed",X="M":"Missing dose",1:"Status Unknown")
  1. S Y=$P(PSBX(0),U,6)+.0000001
  1. S Y=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)_" "_$E(Y,9,10)_":"_$E(Y,11,12)
  1. S Y=Y_" "_$G(PSBASTUS) ;[*70-1489]
  1. W $$WRAP^PSBO(57,15,Y)
  1. W:$G(^XTMP("PSB DEBUG",0)) " (",PSBIEN,") " ;debug write 53.79 ien
  1. ;
  1. D:PSBASTUS["Removed" ;find Give associated with remove event *83
  1. .N RMEV,INI,PSBDD
  1. .S RMEV=$$FINDGIVE^PSBUTL(PSBIEN)
  1. .S Y=$P(RMEV,U)+.0000001 ;give dt/tm
  1. .S INI=$P(RMEV,U,2) ;give by ini
  1. .S X=$P(RMEV,U,3) ;give sts code
  1. .S PSBASTUS=$S(X="G":"Given",X="H":"Held",X="R":"Refused",X="I":"Infusing",X="C":"Completed",X="S":"Stopped",X="N":"Not Given",X="RM":"Removed",X="M":"Missing dose",1:"Status Unknown")
  1. .W !,?50,INI
  1. .S Y=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)_" "_$E(Y,9,10)_":"_$E(Y,11,12)
  1. .S Y=Y_" "_$G(PSBASTUS)
  1. .W $$WRAP^PSBO(57,15,Y)
  1. ;
  1. W:$P(PSBX(.1),U)["V" ?75,"Bag ID #",$$GET1^DIQ(53.79,PSBIEN,"IV UNIQUE ID")
  1. W:$P(PSBX(.1),U)["V" ?107,"NA",?115,"NA",?120,"NA"
  1. W !,$TR($$FMTE^XLFDT($G(PSBOST),2),"@"," ")_">" ;[*70-1489]
  1. F PSBZ=.5,.6,.7 S PSBDHIT=0 F PSBY=0:0 S PSBY=$O(PSBX(PSBZ,PSBY)) Q:'PSBY D
  1. .W:$X>75 !
  1. .S PSBDD=$S(PSBZ=.5:53.795,PSBZ=.6:53.796,1:53.797)
  1. .S Y=$$EXTERNAL^DILFD(PSBDD,.01,"",$P(PSBX(PSBZ,PSBY,0),U,1))
  1. .W $$WRAP^PSBO(75,28,Y)
  1. .I $P(PSBX(.1),U)["U" W ?105,$J($P(PSBX(PSBZ,PSBY,0),U,2),6,2),?113,$J($P(PSBX(PSBZ,PSBY,0),U,3),6,2) W $$WRAP^PSBO(120,12,$P(PSBX(PSBZ,PSBY,0),U,4)) S PSBDHIT=1
  1. .W:$P(PSBX(.1),U)["V"&($X+3+$L($P(PSBX(PSBZ,PSBY,0),U,3))>105) !?75
  1. .W:$P(PSBX(.1),U)["V" " - ",$P(PSBX(PSBZ,PSBY,0),U,2) ;Use units ordered field for IV's, PSB*3*72
  1. D:$P($G(^PSB(53.79,PSBIEN,.1)),U,2)="P"
  1. .W !?16,"PRN Reason: ",?30,$$GET1^DIQ(53.79,PSBIEN_",",.21)
  1. .W !?16,"PRN Effectiveness: "
  1. .I $P($G(^PSB(53.79,PSBIEN,.2)),U,2)="" W "<No PRN Effectiveness Entered>" Q
  1. .N PSBEIECMT S PSBEIECMT="" I $P($G(^PSB(53.79,PSBIEN,.2)),U,2)'="",$P(PSBRPT(.2),U,8)=0 S PSBEIECMT=$$PRNEFF^PSBO(PSBEIECMT,PSBIEN)
  1. .W $$WRAP^PSBO(20,100,$$GET1^DIQ(53.79,PSBIEN_",",.22)_PSBEIECMT)
  1. .W !?20,"Entered By: ",$$GET1^DIQ(53.79,PSBIEN_",",.23)
  1. .W " Date/Time: ",$$GET1^DIQ(53.79,PSBIEN_",",.24)
  1. .W " Minutes: ",$$GET1^DIQ(53.79,PSBIEN_",",.25)
  1. D:$P(PSBRPT(.2),U,8)
  1. .W !?16,"Comments: ",?30 I '$O(PSBX(.3,0)) W "<No Comments>"
  1. .F PSBY=0:0 S PSBY=$O(PSBX(.3,PSBY)) Q:'PSBY D
  1. ..W:$X>30 !?30
  1. ..S Y=$P(PSBX(.3,PSBY,0),U,3)+.0000001
  1. ..W $E(Y,4,5),"/",$E(Y,6,7),"/",$E(Y,2,3)
  1. ..W " ",$E(Y,9,10),":",$E(Y,11,12)
  1. ..W ?46,$$GET1^DIQ(53.793,PSBY_","_PSBIEN_",","ENTERED BY:INITIAL")
  1. ..W $$WRAP^PSBO(52,70,$P(PSBX(.3,PSBY,0),U,1))
  1. .;*70 Witness new line after Comments section chosen
  1. .N WITBY,WITDT,WITCM,WITHR,WITFL
  1. .S WITBY=$$GET1^DIQ(53.79,PSBIEN_",",.29)
  1. .S WITDT=$$GET1^DIQ(53.79,PSBIEN_",",.28,"I")
  1. .S WITCM=$$GET1^DIQ(53.79,PSBIEN_",",.31)
  1. .S WITHR=$$GET1^DIQ(53.79,PSBIEN_",",.32)
  1. .S WITFL=$$GET1^DIQ(53.79,PSBIEN_",",.33)
  1. .I WITBY]"" D
  1. ..W !?16,"Witnessed by:",?30,WITBY," on "
  1. ..W $P($$FMTE^XLFDT($$GET1^DIQ(53.79,PSBIEN_",",.28,"I"),2),":",1,2)
  1. .I WITFL="NO",WITBY="" D
  1. ..W !?16,"Witnessed?:",?30,WITFL
  1. .W:WITCM]"" !,$$WRAP^PSBO(30,102,WITCM)
  1. .;
  1. .W !,$TR($$FMTE^XLFDT($G(PSBOSP),2),"@"," ")_"<" ;[*70-1489]
  1. .;
  1. D:PSBAUDF
  1. .W !?16,"Audits: ",?30 I '$O(PSBX(.9,0)) W "<No Audits>" Q
  1. .F PSBY=0:0 S PSBY=$O(PSBX(.9,PSBY)) Q:'PSBY D
  1. ..W:$X>30 !?30
  1. ..S Y=$P(PSBX(.9,PSBY,0),U,1)+.0000001
  1. ..W $E(Y,4,5),"/",$E(Y,6,7),"/",$E(Y,2,3)
  1. ..W " ",$E(Y,9,10),":",$E(Y,11,12)
  1. ..W ?46,$$GET1^DIQ(53.799,PSBY_","_PSBIEN_",","USER:INITIAL")
  1. ..;*83 special case to alter the how reports Action Status Give from
  1. ..;the word "deleted" to "changed" only when a Remove occurs
  1. ..;(vs an Undo Give) that triggered the deleted. "deleted" is a key
  1. ..;word that other routines test for, fixed via reporting only.
  1. ..N ALIN,NXALIN,XX
  1. ..S ALIN=$P(PSBX(.9,PSBY,0),U,3)
  1. ..S NXALIN=$O(PSBX(.9,PSBY))
  1. ..S NXALIN=$S('NXALIN:"",1:$P(PSBX(.9,NXALIN,0),U,3)) ;*82
  1. ..;if next action is RM then report Give changed instead of deleted.
  1. ..I ALIN["ACTION STATUS",ALIN["deleted",NXALIN["REMOVED" D
  1. ...S XX=$P($P(PSBX(.9,PSBY,0),U,3),"deleted"),XX=XX_"changed."
  1. ...W $$WRAP^PSBO(52,70,XX)
  1. ..E D
  1. ...W $$WRAP^PSBO(52,70,$P(PSBX(.9,PSBY,0),U,3))
  1. W !,$TR($J("",IOM)," ","-")
  1. Q ""
  1. ;
  1. WDHDR(PSBWARD) ;
  1. N PSBCLINORD S PSBCLINORD=2 ;2=both order type hdr *70
  1. S PSBHDR(3)="",PSBHDR(4)="Ward Location: "
  1. D WARD^PSBOHDR(PSBWARD,.PSBHDR,,,PSBSRCHL)
  1. W $$SUB()
  1. Q ""
  1. ;
  1. PTHDR() ;
  1. N PSBCLINORD S PSBCLINORD=2 ;2=both order type hdr *70
  1. S:$G(PSBSRCHL)]"" PSBHDR(3)="",PSBHDR(4)="Ward Location: "
  1. D PT^PSBOHDR(DFN,.PSBHDR,,,PSBSRCHL)
  1. W $$SUB()
  1. Q ""
  1. ;
  1. SUB() ; Med Log Sub Header
  1. W:$X>1 !
  1. W "Location",!
  1. W "Activity Date",?16,"Orderable Item",?50,"Action",?57,"Action"
  1. W !,"Start Date>",?16,"[Dose/Sched/Route/Body Site]",?50,"By"
  1. W ?57,"Date/Time",?75,"Drug/Additive/Solution",?105," U/Ord"
  1. W ?113," U/Gvn",?120,"Unit",!,"Stop Date<"
  1. W !,$TR($J("",IOM)," ","-")
  1. Q ""
  1. ;
  1. MME(PSBIEN) ; Administered via Manual Med Entry?
  1. N MME,CMMT,CMMTND S MME=0
  1. S CMMT="" F S CMMT=$O(^PSB(53.79,+PSBIEN,.3,CMMT)) Q:CMMT=""!$G(MME) D
  1. .S CMMTND=$G(^PSB(53.79,+PSBIEN,.3,CMMT,0)) I CMMTND["Entry created with 'Manual Medication Entry'" S MME=1
  1. Q $S($G(MME):1,1:0)