- PSBOML ;BIRMINGHAM/EFC - MEDICATION LOG ;Sep 09, 2020@14:17:51
- ;;3.0;BAR CODE MED ADMIN;**3,11,50,54,70,72,83,82**;Mar 2004;Build 27
- ;Per VHA Directive 2004-038 (or future revisions regarding same), this routine should not be modified.
- ;
- ; Reference/IA
- ; ^DPT/10035
- ; SENDMSG^XMXAPI/2729
- ; ^XLFDT/10103
- ;
- ;*70 - Add Witness for High Risk Drug to report
- ; - print Clinic name with each order that occurred in a clinic
- ; - set psbclinord=2 for dual hdr text
- ; - create var for Search list and use for both IM & CO, pass to
- ; PSBOHDR api
- ; - 1489: Blended PSB*3*54 with PSB*3*70
- ;*83 - Add MRR meds remove times to report.
- ;
- EN ; Begin printing
- N PSBSTRT,PSBSTOP,PSBHDR,DFN,PSBSORT,PSBSRCHL,PSBTMPG,PSBAUDF,PSBGBL
- S PSBSORT=$P(PSBRPT(.1),U,1) ;*70
- 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 PSBAUDF=$P(PSBRPT(.2),U,9)
- S PSBHDR(0)="Medication Log Report for "_$$FMTE^XLFDT(PSBSTRT)_" to "_$$FMTE^XLFDT(PSBSTOP) ;Add time frame for report header, PSB*3*72
- S PSBHDR(1)="Continuing/PRN/Stat/One Time Medication/Treatment Record (Detailed Log) (VAF 10-2970 B, C, D)"
- ;check Clinic or Nurs Unit search list *70
- S PSBSRCHL=$$SRCHLIST^PSBOHDR()
- ;
- ; Patient Report
- ;
- D:PSBSORT="P"
- .S PSBHDR(2)="Log Type: INDIVIDUAL PATIENT"
- .S DFN=+$P(PSBRPT(.1),U,2)
- .W $$PTHDR()
- .S X=$O(^PSB(53.79,"AADT",DFN,PSBSTRT-.0000001))
- .I X>PSBSTOP!(X="") W !!?10,"<<<< NO MEDICATIONS FOUND FOR THIS TIME FRAME >>>>",!! Q
- .S PSBGBL=$NAME(^PSB(53.79,"AADT",DFN,PSBSTRT-.0000001))
- .F S PSBGBL=$Q(@PSBGBL) Q:PSBGBL="" Q:$QS(PSBGBL,2)'="AADT"!($QS(PSBGBL,3)'=DFN)!($QS(PSBGBL,4)>PSBSTOP) D
- ..S PSBIEN=$QS(PSBGBL,5) Q:'$D(^PSB(53.79,PSBIEN))
- ..I $P(^PSB(53.79,PSBIEN,0),U,6)'=$QS(PSBGBL,4) Q
- ..I $Y>(IOSL-10) W $$PTFTR^PSBOHDR(),$$PTHDR()
- ..W $$LINE(PSBIEN)
- .W $$PTFTR^PSBOHDR()
- ;
- ; Ward Output
- ;
- D:PSBSORT="W"
- .S PSBHDR(2)="LOG TYPE: WARD"
- .W $$WDHDR(PSBWRD)
- .S PSBTMPG=$NAME(^TMP("PSBO",$J,"B"))
- .F S PSBTMPG=$Q(@PSBTMPG) Q:PSBTMPG="" Q:$QS(PSBTMPG,1)'="PSBO"!($QS(PSBTMPG,2)'=$J) D
- ..S DFN=$QS(PSBTMPG,5)
- ..I $Y>(IOSL-14) W $$WDHDR(PSBWRD)
- ..W !,$P(^DPT(DFN,0),U)," (",$P(^(0),U,9),")"
- ..W !,"Ward: ",$G(^DPT(DFN,.1),"***")," Rm-Bed: ",$G(^DPT(DFN,.101),"***"),!
- ..S X=$O(^PSB(53.79,"AADT",DFN,PSBSTRT-.0000001))
- ..I X>PSBSTOP!(X="") W !!?10,"<<<< NO MEDICATIONS FOUND FOR THIS TIME FRAME >>>>",!! Q
- ..S PSBGBL=$NAME(^PSB(53.79,"AADT",DFN,PSBSTRT-.0000001))
- ..F S PSBGBL=$Q(@PSBGBL) Q:PSBGBL="" Q:$QS(PSBGBL,2)'="AADT"!($QS(PSBGBL,3)'=DFN)!($QS(PSBGBL,4)>PSBSTOP) D
- ...S PSBIEN=$QS(PSBGBL,5) I $P(^PSB(53.79,PSBIEN,0),U,6)'=$QS(PSBGBL,4) Q
- ...W:$Y>(IOSL-10) $$WDHDR(PSBWRD)
- ...W $$LINE(PSBIEN)
- Q
- ;
- LINE(PSBIEN) ; Displays the med log entry in PSBIEN
- N PSBX,PSBASTUS,PSBMME,PSBEXIST,PSBY,PSBZ,PSBDHIT
- S X=$P($G(^PSB(53.79,PSBIEN,.1)),U)
- I X="" W !,"Error: Med Log Entry ",PSBIEN," has no order reference number!" Q ""
- I 'PSBAUDF,$P(^PSB(53.79,PSBIEN,0),U,9)="N" Q ""
- D CLEAN^PSBVT
- D PSJ1^PSBVT(DFN,X,,.PSBEXIST)
- ; ;[*70-1489]...start
- 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
- .N XMDUZ,XMSUB,XMTEXT,XMY,PSBERR,PSBPARAM,PSBMG
- .S XMSUB="Order given in BCMA does not exist in Pharmacy Patient file"
- .S XMDUZ=DUZ
- .S XMTEXT="PSBERR"
- .S PSBMG=$$GET^XPAR("DIV","PSB MG ADMIN ERROR",,"E"),PSBMG="G."_PSBMG
- .S XMY(PSBMG)=""
- .S PSBERR(1)="Order #"_$G(PSBIEN)_" given in BCMA no longer has"
- .S PSBERR(2)="a corresponding entry in the Pharmacy Patient (#55) file."
- .S PSBERR(3)="Please submit a remedy ticket for this issue."
- .D SENDMSG^XMXAPI(XMDUZ,XMSUB,XMTEXT,.XMY)
- .Q
- ; ;[*70-1489]...end
- I PSBDFN="-1" W !,"Error: Inpatient Meds API Failure!" Q ""
- M PSBX=^PSB(53.79,PSBIEN)
- S Y=$P(PSBX(0),U,4)+.0000001
- ;*70 print location name per each clinic order
- S PSBMME=$$MME(+$G(PSBIEN)) I $G(PSBMME),($TR($P(PSBX(0),U,2)," ","")="") S $P(PSBX(0),U,2)="MME/UNKNOWN LOCATION"
- W:$P(PSBX(0),U,2)]"" !,?3,$P(PSBX(0),U,2)
- W !,$E(Y,4,5),"/",$E(Y,6,7),"/",$E(Y,2,3)
- W " ",$E(Y,9,10),":",$E(Y,11,12)
- S Y=$$GET1^DIQ(53.79,PSBIEN_",",.08)
- S Y=Y_" ["_$G(PSBDOSE)_$G(PSBIFR)_" "_$G(PSBSCH) ;[*70-1489]
- S Y=Y_" "_$G(PSBMRAB) ;[*70-1489]
- I $P($G(^PSB(53.79,PSBIEN,.1)),U,8)]"" D ;Inj or Derm site info *83
- .S Y=Y_" Derm Site: "_$P(^(.1),U,8)
- E D
- .S:$P(^(.1),U,6)]"" Y=Y_" Inj Site: "_$P(^(.1),U,6)
- ;
- S Y=Y_"]"
- W $$WRAP^PSBO(16,32,Y)
- W ?50,$$GETINIT^PSBCSUTX(PSBIEN,"I") ;Get initials of who took action, PSB*3*72
- S X=$P(PSBX(0),U,9)
- 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")
- S Y=$P(PSBX(0),U,6)+.0000001
- S Y=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)_" "_$E(Y,9,10)_":"_$E(Y,11,12)
- S Y=Y_" "_$G(PSBASTUS) ;[*70-1489]
- W $$WRAP^PSBO(57,15,Y)
- W:$G(^XTMP("PSB DEBUG",0)) " (",PSBIEN,") " ;debug write 53.79 ien
- ;
- D:PSBASTUS["Removed" ;find Give associated with remove event *83
- .N RMEV,INI,PSBDD
- .S RMEV=$$FINDGIVE^PSBUTL(PSBIEN)
- .S Y=$P(RMEV,U)+.0000001 ;give dt/tm
- .S INI=$P(RMEV,U,2) ;give by ini
- .S X=$P(RMEV,U,3) ;give sts code
- .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")
- .W !,?50,INI
- .S Y=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)_" "_$E(Y,9,10)_":"_$E(Y,11,12)
- .S Y=Y_" "_$G(PSBASTUS)
- .W $$WRAP^PSBO(57,15,Y)
- ;
- W:$P(PSBX(.1),U)["V" ?75,"Bag ID #",$$GET1^DIQ(53.79,PSBIEN,"IV UNIQUE ID")
- W:$P(PSBX(.1),U)["V" ?107,"NA",?115,"NA",?120,"NA"
- W !,$TR($$FMTE^XLFDT($G(PSBOST),2),"@"," ")_">" ;[*70-1489]
- F PSBZ=.5,.6,.7 S PSBDHIT=0 F PSBY=0:0 S PSBY=$O(PSBX(PSBZ,PSBY)) Q:'PSBY D
- .W:$X>75 !
- .S PSBDD=$S(PSBZ=.5:53.795,PSBZ=.6:53.796,1:53.797)
- .S Y=$$EXTERNAL^DILFD(PSBDD,.01,"",$P(PSBX(PSBZ,PSBY,0),U,1))
- .W $$WRAP^PSBO(75,28,Y)
- .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
- .W:$P(PSBX(.1),U)["V"&($X+3+$L($P(PSBX(PSBZ,PSBY,0),U,3))>105) !?75
- .W:$P(PSBX(.1),U)["V" " - ",$P(PSBX(PSBZ,PSBY,0),U,2) ;Use units ordered field for IV's, PSB*3*72
- D:$P($G(^PSB(53.79,PSBIEN,.1)),U,2)="P"
- .W !?16,"PRN Reason: ",?30,$$GET1^DIQ(53.79,PSBIEN_",",.21)
- .W !?16,"PRN Effectiveness: "
- .I $P($G(^PSB(53.79,PSBIEN,.2)),U,2)="" W "<No PRN Effectiveness Entered>" Q
- .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)
- .W $$WRAP^PSBO(20,100,$$GET1^DIQ(53.79,PSBIEN_",",.22)_PSBEIECMT)
- .W !?20,"Entered By: ",$$GET1^DIQ(53.79,PSBIEN_",",.23)
- .W " Date/Time: ",$$GET1^DIQ(53.79,PSBIEN_",",.24)
- .W " Minutes: ",$$GET1^DIQ(53.79,PSBIEN_",",.25)
- D:$P(PSBRPT(.2),U,8)
- .W !?16,"Comments: ",?30 I '$O(PSBX(.3,0)) W "<No Comments>"
- .F PSBY=0:0 S PSBY=$O(PSBX(.3,PSBY)) Q:'PSBY D
- ..W:$X>30 !?30
- ..S Y=$P(PSBX(.3,PSBY,0),U,3)+.0000001
- ..W $E(Y,4,5),"/",$E(Y,6,7),"/",$E(Y,2,3)
- ..W " ",$E(Y,9,10),":",$E(Y,11,12)
- ..W ?46,$$GET1^DIQ(53.793,PSBY_","_PSBIEN_",","ENTERED BY:INITIAL")
- ..W $$WRAP^PSBO(52,70,$P(PSBX(.3,PSBY,0),U,1))
- .;*70 Witness new line after Comments section chosen
- .N WITBY,WITDT,WITCM,WITHR,WITFL
- .S WITBY=$$GET1^DIQ(53.79,PSBIEN_",",.29)
- .S WITDT=$$GET1^DIQ(53.79,PSBIEN_",",.28,"I")
- .S WITCM=$$GET1^DIQ(53.79,PSBIEN_",",.31)
- .S WITHR=$$GET1^DIQ(53.79,PSBIEN_",",.32)
- .S WITFL=$$GET1^DIQ(53.79,PSBIEN_",",.33)
- .I WITBY]"" D
- ..W !?16,"Witnessed by:",?30,WITBY," on "
- ..W $P($$FMTE^XLFDT($$GET1^DIQ(53.79,PSBIEN_",",.28,"I"),2),":",1,2)
- .I WITFL="NO",WITBY="" D
- ..W !?16,"Witnessed?:",?30,WITFL
- .W:WITCM]"" !,$$WRAP^PSBO(30,102,WITCM)
- .;
- .W !,$TR($$FMTE^XLFDT($G(PSBOSP),2),"@"," ")_"<" ;[*70-1489]
- .;
- D:PSBAUDF
- .W !?16,"Audits: ",?30 I '$O(PSBX(.9,0)) W "<No Audits>" Q
- .F PSBY=0:0 S PSBY=$O(PSBX(.9,PSBY)) Q:'PSBY D
- ..W:$X>30 !?30
- ..S Y=$P(PSBX(.9,PSBY,0),U,1)+.0000001
- ..W $E(Y,4,5),"/",$E(Y,6,7),"/",$E(Y,2,3)
- ..W " ",$E(Y,9,10),":",$E(Y,11,12)
- ..W ?46,$$GET1^DIQ(53.799,PSBY_","_PSBIEN_",","USER:INITIAL")
- ..;*83 special case to alter the how reports Action Status Give from
- ..;the word "deleted" to "changed" only when a Remove occurs
- ..;(vs an Undo Give) that triggered the deleted. "deleted" is a key
- ..;word that other routines test for, fixed via reporting only.
- ..N ALIN,NXALIN,XX
- ..S ALIN=$P(PSBX(.9,PSBY,0),U,3)
- ..S NXALIN=$O(PSBX(.9,PSBY))
- ..S NXALIN=$S('NXALIN:"",1:$P(PSBX(.9,NXALIN,0),U,3)) ;*82
- ..;if next action is RM then report Give changed instead of deleted.
- ..I ALIN["ACTION STATUS",ALIN["deleted",NXALIN["REMOVED" D
- ...S XX=$P($P(PSBX(.9,PSBY,0),U,3),"deleted"),XX=XX_"changed."
- ...W $$WRAP^PSBO(52,70,XX)
- ..E D
- ...W $$WRAP^PSBO(52,70,$P(PSBX(.9,PSBY,0),U,3))
- W !,$TR($J("",IOM)," ","-")
- Q ""
- ;
- WDHDR(PSBWARD) ;
- N PSBCLINORD S PSBCLINORD=2 ;2=both order type hdr *70
- S PSBHDR(3)="",PSBHDR(4)="Ward Location: "
- D WARD^PSBOHDR(PSBWARD,.PSBHDR,,,PSBSRCHL)
- W $$SUB()
- Q ""
- ;
- PTHDR() ;
- N PSBCLINORD S PSBCLINORD=2 ;2=both order type hdr *70
- S:$G(PSBSRCHL)]"" PSBHDR(3)="",PSBHDR(4)="Ward Location: "
- D PT^PSBOHDR(DFN,.PSBHDR,,,PSBSRCHL)
- W $$SUB()
- Q ""
- ;
- SUB() ; Med Log Sub Header
- W:$X>1 !
- W "Location",!
- W "Activity Date",?16,"Orderable Item",?50,"Action",?57,"Action"
- W !,"Start Date>",?16,"[Dose/Sched/Route/Body Site]",?50,"By"
- W ?57,"Date/Time",?75,"Drug/Additive/Solution",?105," U/Ord"
- W ?113," U/Gvn",?120,"Unit",!,"Stop Date<"
- W !,$TR($J("",IOM)," ","-")
- Q ""
- ;
- MME(PSBIEN) ; Administered via Manual Med Entry?
- N MME,CMMT,CMMTND S MME=0
- S CMMT="" F S CMMT=$O(^PSB(53.79,+PSBIEN,.3,CMMT)) Q:CMMT=""!$G(MME) D
- .S CMMTND=$G(^PSB(53.79,+PSBIEN,.3,CMMT,0)) I CMMTND["Entry created with 'Manual Medication Entry'" S MME=1
- Q $S($G(MME):1,1:0)
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSBOML 10241 printed Feb 18, 2025@23:07:05 Page 2
- 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
- +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 ; SENDMSG^XMXAPI/2729
- +7 ; ^XLFDT/10103
- +8 ;
- +9 ;*70 - Add Witness for High Risk Drug to report
- +10 ; - print Clinic name with each order that occurred in a clinic
- +11 ; - set psbclinord=2 for dual hdr text
- +12 ; - create var for Search list and use for both IM & CO, pass to
- +13 ; PSBOHDR api
- +14 ; - 1489: Blended PSB*3*54 with PSB*3*70
- +15 ;*83 - Add MRR meds remove times to report.
- +16 ;
- EN ; Begin printing
- +1 NEW PSBSTRT,PSBSTOP,PSBHDR,DFN,PSBSORT,PSBSRCHL,PSBTMPG,PSBAUDF,PSBGBL
- +2 ;*70
- SET PSBSORT=$PIECE(PSBRPT(.1),U,1)
- +3 SET PSBSTRT=$PIECE(PSBRPT(.1),U,6)+$PIECE(PSBRPT(.1),U,7)
- +4 SET PSBSTOP=$PIECE(PSBRPT(.1),U,8)+$PIECE(PSBRPT(.1),U,9)
- +5 SET PSBAUDF=$PIECE(PSBRPT(.2),U,9)
- +6 ;Add time frame for report header, PSB*3*72
- SET PSBHDR(0)="Medication Log Report for "_$$FMTE^XLFDT(PSBSTRT)_" to "_$$FMTE^XLFDT(PSBSTOP)
- +7 SET PSBHDR(1)="Continuing/PRN/Stat/One Time Medication/Treatment Record (Detailed Log) (VAF 10-2970 B, C, D)"
- +8 ;check Clinic or Nurs Unit search list *70
- +9 SET PSBSRCHL=$$SRCHLIST^PSBOHDR()
- +10 ;
- +11 ; Patient Report
- +12 ;
- +13 if PSBSORT="P"
- Begin DoDot:1
- +14 SET PSBHDR(2)="Log Type: INDIVIDUAL PATIENT"
- +15 SET DFN=+$PIECE(PSBRPT(.1),U,2)
- +16 WRITE $$PTHDR()
- +17 SET X=$ORDER(^PSB(53.79,"AADT",DFN,PSBSTRT-.0000001))
- +18 IF X>PSBSTOP!(X="")
- WRITE !!?10,"<<<< NO MEDICATIONS FOUND FOR THIS TIME FRAME >>>>",!!
- QUIT
- +19 SET PSBGBL=$NAME(^PSB(53.79,"AADT",DFN,PSBSTRT-.0000001))
- +20 FOR
- SET PSBGBL=$QUERY(@PSBGBL)
- if PSBGBL=""
- QUIT
- if $QSUBSCRIPT(PSBGBL,2)'="AADT"!($QSUBSCRIPT(PSBGBL,3)'=DFN)!($QSUBSCRIPT(PSBGBL,4)>PSBSTOP)
- QUIT
- Begin DoDot:2
- +21 SET PSBIEN=$QSUBSCRIPT(PSBGBL,5)
- if '$DATA(^PSB(53.79,PSBIEN))
- QUIT
- +22 IF $PIECE(^PSB(53.79,PSBIEN,0),U,6)'=$QSUBSCRIPT(PSBGBL,4)
- QUIT
- +23 IF $Y>(IOSL-10)
- WRITE $$PTFTR^PSBOHDR(),$$PTHDR()
- +24 WRITE $$LINE(PSBIEN)
- End DoDot:2
- +25 WRITE $$PTFTR^PSBOHDR()
- End DoDot:1
- +26 ;
- +27 ; Ward Output
- +28 ;
- +29 if PSBSORT="W"
- Begin DoDot:1
- +30 SET PSBHDR(2)="LOG TYPE: WARD"
- +31 WRITE $$WDHDR(PSBWRD)
- +32 SET PSBTMPG=$NAME(^TMP("PSBO",$JOB,"B"))
- +33 FOR
- SET PSBTMPG=$QUERY(@PSBTMPG)
- if PSBTMPG=""
- QUIT
- if $QSUBSCRIPT(PSBTMPG,1)'="PSBO"!($QSUBSCRIPT(PSBTMPG,2)'=$JOB)
- QUIT
- Begin DoDot:2
- +34 SET DFN=$QSUBSCRIPT(PSBTMPG,5)
- +35 IF $Y>(IOSL-14)
- WRITE $$WDHDR(PSBWRD)
- +36 WRITE !,$PIECE(^DPT(DFN,0),U)," (",$PIECE(^(0),U,9),")"
- +37 WRITE !,"Ward: ",$GET(^DPT(DFN,.1),"***")," Rm-Bed: ",$GET(^DPT(DFN,.101),"***"),!
- +38 SET X=$ORDER(^PSB(53.79,"AADT",DFN,PSBSTRT-.0000001))
- +39 IF X>PSBSTOP!(X="")
- WRITE !!?10,"<<<< NO MEDICATIONS FOUND FOR THIS TIME FRAME >>>>",!!
- QUIT
- +40 SET PSBGBL=$NAME(^PSB(53.79,"AADT",DFN,PSBSTRT-.0000001))
- +41 FOR
- SET PSBGBL=$QUERY(@PSBGBL)
- if PSBGBL=""
- QUIT
- if $QSUBSCRIPT(PSBGBL,2)'="AADT"!($QSUBSCRIPT(PSBGBL,3)'=DFN)!($QSUBSCRIPT(PSBGBL,4)>PSBSTOP)
- QUIT
- Begin DoDot:3
- +42 SET PSBIEN=$QSUBSCRIPT(PSBGBL,5)
- IF $PIECE(^PSB(53.79,PSBIEN,0),U,6)'=$QSUBSCRIPT(PSBGBL,4)
- QUIT
- +43 if $Y>(IOSL-10)
- WRITE $$WDHDR(PSBWRD)
- +44 WRITE $$LINE(PSBIEN)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +45 QUIT
- +46 ;
- LINE(PSBIEN) ; Displays the med log entry in PSBIEN
- +1 NEW PSBX,PSBASTUS,PSBMME,PSBEXIST,PSBY,PSBZ,PSBDHIT
- +2 SET X=$PIECE($GET(^PSB(53.79,PSBIEN,.1)),U)
- +3 IF X=""
- WRITE !,"Error: Med Log Entry ",PSBIEN," has no order reference number!"
- QUIT ""
- +4 IF 'PSBAUDF
- IF $PIECE(^PSB(53.79,PSBIEN,0),U,9)="N"
- QUIT ""
- +5 DO CLEAN^PSBVT
- +6 DO PSJ1^PSBVT(DFN,X,,.PSBEXIST)
- +7 ; ;[*70-1489]...start
- +8 ;send email to BCMA UKNOWN ACTIONS group if order given in BCMA does not have a corresponding # 55 file entry
- IF '$GET(PSBEXIST)
- IF ($GET(PSBSCRT)="-1")
- Begin DoDot:1
- +9 NEW XMDUZ,XMSUB,XMTEXT,XMY,PSBERR,PSBPARAM,PSBMG
- +10 SET XMSUB="Order given in BCMA does not exist in Pharmacy Patient file"
- +11 SET XMDUZ=DUZ
- +12 SET XMTEXT="PSBERR"
- +13 SET PSBMG=$$GET^XPAR("DIV","PSB MG ADMIN ERROR",,"E")
- SET PSBMG="G."_PSBMG
- +14 SET XMY(PSBMG)=""
- +15 SET PSBERR(1)="Order #"_$GET(PSBIEN)_" given in BCMA no longer has"
- +16 SET PSBERR(2)="a corresponding entry in the Pharmacy Patient (#55) file."
- +17 SET PSBERR(3)="Please submit a remedy ticket for this issue."
- +18 DO SENDMSG^XMXAPI(XMDUZ,XMSUB,XMTEXT,.XMY)
- +19 QUIT
- End DoDot:1
- +20 ; ;[*70-1489]...end
- +21 IF PSBDFN="-1"
- WRITE !,"Error: Inpatient Meds API Failure!"
- QUIT ""
- +22 MERGE PSBX=^PSB(53.79,PSBIEN)
- +23 SET Y=$PIECE(PSBX(0),U,4)+.0000001
- +24 ;*70 print location name per each clinic order
- +25 SET PSBMME=$$MME(+$GET(PSBIEN))
- IF $GET(PSBMME)
- IF ($TRANSLATE($PIECE(PSBX(0),U,2)," ","")="")
- SET $PIECE(PSBX(0),U,2)="MME/UNKNOWN LOCATION"
- +26 if $PIECE(PSBX(0),U,2)]""
- WRITE !,?3,$PIECE(PSBX(0),U,2)
- +27 WRITE !,$EXTRACT(Y,4,5),"/",$EXTRACT(Y,6,7),"/",$EXTRACT(Y,2,3)
- +28 WRITE " ",$EXTRACT(Y,9,10),":",$EXTRACT(Y,11,12)
- +29 SET Y=$$GET1^DIQ(53.79,PSBIEN_",",.08)
- +30 ;[*70-1489]
- SET Y=Y_" ["_$GET(PSBDOSE)_$GET(PSBIFR)_" "_$GET(PSBSCH)
- +31 ;[*70-1489]
- SET Y=Y_" "_$GET(PSBMRAB)
- +32 ;Inj or Derm site info *83
- IF $PIECE($GET(^PSB(53.79,PSBIEN,.1)),U,8)]""
- Begin DoDot:1
- +33 SET Y=Y_" Derm Site: "_$PIECE(^(.1),U,8)
- End DoDot:1
- +34 IF '$TEST
- Begin DoDot:1
- +35 if $PIECE(^(.1),U,6)]""
- SET Y=Y_" Inj Site: "_$PIECE(^(.1),U,6)
- End DoDot:1
- +36 ;
- +37 SET Y=Y_"]"
- +38 WRITE $$WRAP^PSBO(16,32,Y)
- +39 ;Get initials of who took action, PSB*3*72
- WRITE ?50,$$GETINIT^PSBCSUTX(PSBIEN,"I")
- +40 SET X=$PIECE(PSBX(0),U,9)
- +41 SET PSBASTUS=$SELECT(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")
- +42 SET Y=$PIECE(PSBX(0),U,6)+.0000001
- +43 SET Y=$EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_"/"_$EXTRACT(Y,2,3)_" "_$EXTRACT(Y,9,10)_":"_$EXTRACT(Y,11,12)
- +44 ;[*70-1489]
- SET Y=Y_" "_$GET(PSBASTUS)
- +45 WRITE $$WRAP^PSBO(57,15,Y)
- +46 ;debug write 53.79 ien
- if $GET(^XTMP("PSB DEBUG",0))
- WRITE " (",PSBIEN,") "
- +47 ;
- +48 ;find Give associated with remove event *83
- if PSBASTUS["Removed"
- Begin DoDot:1
- +49 NEW RMEV,INI,PSBDD
- +50 SET RMEV=$$FINDGIVE^PSBUTL(PSBIEN)
- +51 ;give dt/tm
- SET Y=$PIECE(RMEV,U)+.0000001
- +52 ;give by ini
- SET INI=$PIECE(RMEV,U,2)
- +53 ;give sts code
- SET X=$PIECE(RMEV,U,3)
- +54 SET PSBASTUS=$SELECT(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")
- +55 WRITE !,?50,INI
- +56 SET Y=$EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_"/"_$EXTRACT(Y,2,3)_" "_$EXTRACT(Y,9,10)_":"_$EXTRACT(Y,11,12)
- +57 SET Y=Y_" "_$GET(PSBASTUS)
- +58 WRITE $$WRAP^PSBO(57,15,Y)
- End DoDot:1
- +59 ;
- +60 if $PIECE(PSBX(.1),U)["V"
- WRITE ?75,"Bag ID #",$$GET1^DIQ(53.79,PSBIEN,"IV UNIQUE ID")
- +61 if $PIECE(PSBX(.1),U)["V"
- WRITE ?107,"NA",?115,"NA",?120,"NA"
- +62 ;[*70-1489]
- WRITE !,$TRANSLATE($$FMTE^XLFDT($GET(PSBOST),2),"@"," ")_">"
- +63 FOR PSBZ=.5,.6,.7
- SET PSBDHIT=0
- FOR PSBY=0:0
- SET PSBY=$ORDER(PSBX(PSBZ,PSBY))
- if 'PSBY
- QUIT
- Begin DoDot:1
- +64 if $X>75
- WRITE !
- +65 SET PSBDD=$SELECT(PSBZ=.5:53.795,PSBZ=.6:53.796,1:53.797)
- +66 SET Y=$$EXTERNAL^DILFD(PSBDD,.01,"",$PIECE(PSBX(PSBZ,PSBY,0),U,1))
- +67 WRITE $$WRAP^PSBO(75,28,Y)
- +68 IF $PIECE(PSBX(.1),U)["U"
- WRITE ?105,$JUSTIFY($PIECE(PSBX(PSBZ,PSBY,0),U,2),6,2),?113,$JUSTIFY($PIECE(PSBX(PSBZ,PSBY,0),U,3),6,2)
- WRITE $$WRAP^PSBO(120,12,$PIECE(PSBX(PSBZ,PSBY,0),U,4))
- SET PSBDHIT=1
- +69 if $PIECE(PSBX(.1),U)["V"&($X+3+$LENGTH($PIECE(PSBX(PSBZ,PSBY,0),U,3))>105)
- WRITE !?75
- +70 ;Use units ordered field for IV's, PSB*3*72
- if $PIECE(PSBX(.1),U)["V"
- WRITE " - ",$PIECE(PSBX(PSBZ,PSBY,0),U,2)
- End DoDot:1
- +71 if $PIECE($GET(^PSB(53.79,PSBIEN,.1)),U,2)="P"
- Begin DoDot:1
- +72 WRITE !?16,"PRN Reason: ",?30,$$GET1^DIQ(53.79,PSBIEN_",",.21)
- +73 WRITE !?16,"PRN Effectiveness: "
- +74 IF $PIECE($GET(^PSB(53.79,PSBIEN,.2)),U,2)=""
- WRITE "<No PRN Effectiveness Entered>"
- QUIT
- +75 NEW PSBEIECMT
- SET PSBEIECMT=""
- IF $PIECE($GET(^PSB(53.79,PSBIEN,.2)),U,2)'=""
- IF $PIECE(PSBRPT(.2),U,8)=0
- SET PSBEIECMT=$$PRNEFF^PSBO(PSBEIECMT,PSBIEN)
- +76 WRITE $$WRAP^PSBO(20,100,$$GET1^DIQ(53.79,PSBIEN_",",.22)_PSBEIECMT)
- +77 WRITE !?20,"Entered By: ",$$GET1^DIQ(53.79,PSBIEN_",",.23)
- +78 WRITE " Date/Time: ",$$GET1^DIQ(53.79,PSBIEN_",",.24)
- +79 WRITE " Minutes: ",$$GET1^DIQ(53.79,PSBIEN_",",.25)
- End DoDot:1
- +80 if $PIECE(PSBRPT(.2),U,8)
- Begin DoDot:1
- +81 WRITE !?16,"Comments: ",?30
- IF '$ORDER(PSBX(.3,0))
- WRITE "<No Comments>"
- +82 FOR PSBY=0:0
- SET PSBY=$ORDER(PSBX(.3,PSBY))
- if 'PSBY
- QUIT
- Begin DoDot:2
- +83 if $X>30
- WRITE !?30
- +84 SET Y=$PIECE(PSBX(.3,PSBY,0),U,3)+.0000001
- +85 WRITE $EXTRACT(Y,4,5),"/",$EXTRACT(Y,6,7),"/",$EXTRACT(Y,2,3)
- +86 WRITE " ",$EXTRACT(Y,9,10),":",$EXTRACT(Y,11,12)
- +87 WRITE ?46,$$GET1^DIQ(53.793,PSBY_","_PSBIEN_",","ENTERED BY:INITIAL")
- +88 WRITE $$WRAP^PSBO(52,70,$PIECE(PSBX(.3,PSBY,0),U,1))
- End DoDot:2
- +89 ;*70 Witness new line after Comments section chosen
- +90 NEW WITBY,WITDT,WITCM,WITHR,WITFL
- +91 SET WITBY=$$GET1^DIQ(53.79,PSBIEN_",",.29)
- +92 SET WITDT=$$GET1^DIQ(53.79,PSBIEN_",",.28,"I")
- +93 SET WITCM=$$GET1^DIQ(53.79,PSBIEN_",",.31)
- +94 SET WITHR=$$GET1^DIQ(53.79,PSBIEN_",",.32)
- +95 SET WITFL=$$GET1^DIQ(53.79,PSBIEN_",",.33)
- +96 IF WITBY]""
- Begin DoDot:2
- +97 WRITE !?16,"Witnessed by:",?30,WITBY," on "
- +98 WRITE $PIECE($$FMTE^XLFDT($$GET1^DIQ(53.79,PSBIEN_",",.28,"I"),2),":",1,2)
- End DoDot:2
- +99 IF WITFL="NO"
- IF WITBY=""
- Begin DoDot:2
- +100 WRITE !?16,"Witnessed?:",?30,WITFL
- End DoDot:2
- +101 if WITCM]""
- WRITE !,$$WRAP^PSBO(30,102,WITCM)
- +102 ;
- +103 ;[*70-1489]
- WRITE !,$TRANSLATE($$FMTE^XLFDT($GET(PSBOSP),2),"@"," ")_"<"
- +104 ;
- End DoDot:1
- +105 if PSBAUDF
- Begin DoDot:1
- +106 WRITE !?16,"Audits: ",?30
- IF '$ORDER(PSBX(.9,0))
- WRITE "<No Audits>"
- QUIT
- +107 FOR PSBY=0:0
- SET PSBY=$ORDER(PSBX(.9,PSBY))
- if 'PSBY
- QUIT
- Begin DoDot:2
- +108 if $X>30
- WRITE !?30
- +109 SET Y=$PIECE(PSBX(.9,PSBY,0),U,1)+.0000001
- +110 WRITE $EXTRACT(Y,4,5),"/",$EXTRACT(Y,6,7),"/",$EXTRACT(Y,2,3)
- +111 WRITE " ",$EXTRACT(Y,9,10),":",$EXTRACT(Y,11,12)
- +112 WRITE ?46,$$GET1^DIQ(53.799,PSBY_","_PSBIEN_",","USER:INITIAL")
- +113 ;*83 special case to alter the how reports Action Status Give from
- +114 ;the word "deleted" to "changed" only when a Remove occurs
- +115 ;(vs an Undo Give) that triggered the deleted. "deleted" is a key
- +116 ;word that other routines test for, fixed via reporting only.
- +117 NEW ALIN,NXALIN,XX
- +118 SET ALIN=$PIECE(PSBX(.9,PSBY,0),U,3)
- +119 SET NXALIN=$ORDER(PSBX(.9,PSBY))
- +120 ;*82
- SET NXALIN=$SELECT('NXALIN:"",1:$PIECE(PSBX(.9,NXALIN,0),U,3))
- +121 ;if next action is RM then report Give changed instead of deleted.
- +122 IF ALIN["ACTION STATUS"
- IF ALIN["deleted"
- IF NXALIN["REMOVED"
- Begin DoDot:3
- +123 SET XX=$PIECE($PIECE(PSBX(.9,PSBY,0),U,3),"deleted")
- SET XX=XX_"changed."
- +124 WRITE $$WRAP^PSBO(52,70,XX)
- End DoDot:3
- +125 IF '$TEST
- Begin DoDot:3
- +126 WRITE $$WRAP^PSBO(52,70,$PIECE(PSBX(.9,PSBY,0),U,3))
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +127 WRITE !,$TRANSLATE($JUSTIFY("",IOM)," ","-")
- +128 QUIT ""
- +129 ;
- WDHDR(PSBWARD) ;
- +1 ;2=both order type hdr *70
- NEW PSBCLINORD
- SET PSBCLINORD=2
- +2 SET PSBHDR(3)=""
- SET PSBHDR(4)="Ward Location: "
- +3 DO WARD^PSBOHDR(PSBWARD,.PSBHDR,,,PSBSRCHL)
- +4 WRITE $$SUB()
- +5 QUIT ""
- +6 ;
- PTHDR() ;
- +1 ;2=both order type hdr *70
- NEW PSBCLINORD
- SET PSBCLINORD=2
- +2 if $GET(PSBSRCHL)]""
- SET PSBHDR(3)=""
- SET PSBHDR(4)="Ward Location: "
- +3 DO PT^PSBOHDR(DFN,.PSBHDR,,,PSBSRCHL)
- +4 WRITE $$SUB()
- +5 QUIT ""
- +6 ;
- SUB() ; Med Log Sub Header
- +1 if $X>1
- WRITE !
- +2 WRITE "Location",!
- +3 WRITE "Activity Date",?16,"Orderable Item",?50,"Action",?57,"Action"
- +4 WRITE !,"Start Date>",?16,"[Dose/Sched/Route/Body Site]",?50,"By"
- +5 WRITE ?57,"Date/Time",?75,"Drug/Additive/Solution",?105," U/Ord"
- +6 WRITE ?113," U/Gvn",?120,"Unit",!,"Stop Date<"
- +7 WRITE !,$TRANSLATE($JUSTIFY("",IOM)," ","-")
- +8 QUIT ""
- +9 ;
- MME(PSBIEN) ; Administered via Manual Med Entry?
- +1 NEW MME,CMMT,CMMTND
- SET MME=0
- +2 SET CMMT=""
- FOR
- SET CMMT=$ORDER(^PSB(53.79,+PSBIEN,.3,CMMT))
- if CMMT=""!$GET(MME)
- QUIT
- Begin DoDot:1
- +3 SET CMMTND=$GET(^PSB(53.79,+PSBIEN,.3,CMMT,0))
- IF CMMTND["Entry created with 'Manual Medication Entry'"
- SET MME=1
- End DoDot:1
- +4 QUIT $SELECT($GET(MME):1,1:0)