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

PSBOMM.m

Go to the documentation of this file. 
  1. PSBOMM ;BIRMINGHAM/EFC-MISSED MEDS ;07-Feb-2013 10:04;PLS
  1.  ;;3.0;BAR CODE MED ADMIN;**1005,26,32,1010,56,1015**;Mar 2004;Build 62
  1.  ;Per VHA Directive 2004-038 (or future revisions regarding same), this routine should not be modified.
  1.  ; Modified - IHS/MSC/PLS - 02/22/07 - Line PRINT+56
  1.  ;
  1.  ; Reference/IA
  1.  ; ^DPT/10035
  1.  ; EN^PSJBCMA/2828
  1.  ; EN^PSJBCMA2/2830
  1. EN ;
  1.  N PSBSTRT,PSBSTOP,DFN,PSBODATE,PSBFLAG,PSBCNT,PSBEDIT,PSBFUTR
  1.  S PSBSTART=$P(PSBRPT(.1),U,6)+$P(PSBRPT(.1),U,7),PSBSTOP=$P(PSBRPT(.1),U,8)+$P(PSBRPT(.1),U,9)
  1.  D DEFLT^PSBOMM2
  1.  K PSBOCRIT,PSBACRIT,PSBS
  1.  S PSBOCRIT="^A^H^O" ;PSB*3*56 Adds the On Call Status to the Missed Meds Report
  1.  S:$P(PSBFUTR,U,8) PSBOCRIT=PSBOCRIT_"^D^DE" S:$P(PSBFUTR,U,7) PSBOCRIT=PSBOCRIT_"^E"
  1.  S PSBACRIT="MG"
  1.  S:$P(PSBFUTR,U,17) PSBACRIT=PSBACRIT_"H" S:$P(PSBFUTR,U,18) PSBACRIT=PSBACRIT_"R"
  1.  S PSBINCC=0 S:$P(PSBRPT(.2),U,8) PSBINCC=1
  1.  K ^TMP("PSJ",$J),^TMP("PSB",$J),^TMP("PSB1",$J)
  1.  S PSBSTRT=$P(PSBRPT(.1),U,6)+$P(PSBRPT(.1),U,7)-.0000001
  1.  F DFN=0:0 S DFN=$O(^TMP("PSBO",$J,DFN)) Q:'DFN  D EN1
  1.  D PRINT
  1.  K ^TMP("PSJ",$J),^TMP("PSB",$J),^TMP("PSBO",$J),PSBS
  1.  Q
  1. EN1 ;
  1.  N PSBGBL,PSBHDR,PSBX,PSBDFN,PSBDT,PSBEVDT,PSBH
  1.  K ^TMP("PSJ",$J) S PSBEVDT=PSBSTRT
  1.  D EN^PSJBCMA(DFN,PSBSTRT)
  1.  Q:^TMP("PSJ",$J,1,0)=-1
  1.  S PSBX=""
  1.  F  S PSBX=$O(^TMP("PSJ",$J,PSBX)) Q:PSBX=""  D
  1.  .Q:^TMP("PSJ",$J,PSBX,0)=-1
  1.  .D NOW^%DTC
  1.  .D CLEAN^PSBVT
  1.  .D PSJ^PSBVT(PSBX)
  1.  .Q:PSBIVT="A"
  1.  .Q:PSBIVT="H"
  1.  .I PSBIVT["S",PSBISYR'=1 Q
  1.  .I PSBIVT["C",PSBCHEMT'="P",PSBISYR'=1 Q
  1.  .I PSBIVT["C",PSBCHEMT="A" Q
  1.  .Q:PSBONX["P"
  1.  .Q:PSBOSP<PSBSTART
  1.  .I %>PSBOSP,PSBOSTS'="D",PSBOSTS'="DE",PSBOSTS'="H" S PSBOSTS="E"
  1.  .I PSBSCHT="C" D  Q
  1.  ..S (PSBYES,PSBODD)=0
  1.  ..S PSBDOW="SU^MO^TU^WE^TH^FR^SA" F I=1:1:7 I $P(PSBDOW,"^",I)=$E(PSBSCH,1,2) S PSBYES=1
  1.  ..I PSBYES,PSBADST="" Q
  1.  ..F I=1:1 Q:$P(PSBSCH,"-",I)=""  I $P(PSBSCH,"-",I)?2N!($P(PSBSCH,"-",I)?4N) S PSBYES=1
  1.  ..S PSBFREQ=$$GETFREQ^PSBVDLU1(DFN,PSBONX)
  1.  ..I PSBFREQ="O" S PSBYES=1,PSBFREQ=1440
  1.  ..I 'PSBYES,PSBADST="",PSBFREQ<1 Q
  1.  ..I (PSBFREQ#1440'=0),(1440#PSBFREQ'=0) S PSBODD=1
  1.  ..I PSBODD,PSBADST'="" Q
  1.  ..Q:PSBOCRIT'[PSBOSTS
  1.  ..Q:PSBNGF
  1.  ..Q:PSBOSTS="N"
  1.  ..Q:PSBSM
  1.  ..S PSBS(DFN,PSBONX,$S(PSBOSTS="A":"Active",PSBOSTS="H":"On Hold",PSBOSTS="D":"DC'd",PSBOSTS="DE":"DC'd (Edit)",PSBOSTS="E":"Expired",PSBOSTS="O":"On Call",1:" *Unknown* "))=""
  1.  ..S PSBSTXP(PSBONX,$$DTFMT^PSBOMM2(PSBOSP))=""
  1.  ..S PSBCADM=0
  1.  ..I PSBADST="" D  Q:$G(PSBADST)=""  S PSBCADM=1
  1.  ...S X=PSBOST D H^%DTC S X1=((%H*24)*60)+(%T/60)
  1.  ...S X=PSBSTRT,X3=0 D H^%DTC S X2=((%H*24)*60)+(%T/60)
  1.  ...I X2'<X1 S X3=X2-X1 S PSBOST=$$FMADD^XLFDT(PSBSTRT,,,(-1*(X3#PSBFREQ)))
  1.  ...K PSBADST S PSBOST2=PSBOST,PSBDT2=PSBSTRT
  1.  ...F XZ=0:1 S PSBADST(XZ,PSBDT2)=$$GETADMIN^PSBVDLU1(DFN,PSBONX,PSBOST2,PSBFREQ,PSBDT2) D  Q:PSBDT2>PSBSTOP
  1.  ....I ($L(PSBADST(XZ,PSBDT2),"-")>$L($G(PSBADST),"-"))!($G(PSBADST)="") S PSBADST=PSBADST(XZ,PSBDT2)
  1.  ....S Z=PSBDT2\1,J=$P(PSBADST(XZ,PSBDT2),"-",($L(PSBADST(XZ,PSBDT2),"-"))) S:J]"" PSBOST2=Z_"."_J
  1.  ....S PSBDT2=($$FMADD^XLFDT(Z,1))+.2400
  1.  ....S PSBDT2=$S($G(FLG):(PSBSTOP\1)+.2401,PSBDT2>PSBOSP:PSBOSP,1:PSBDT2) K FLG I PSBDT2=PSBOSP S FLG=1
  1.  ..S Z=PSBADST I Z]"" K ^TMP("PSB",$J,"GETADMIN") S ^TMP("PSB",$J,"GETADMIN",0)=Z
  1.  ..F Y=1:1:$L(Z,"-") D
  1.  ...Q:($P(Z,"-",Y)'?2N)&($P(Z,"-",Y)'?4N)
  1.  ..K PSBOACTL,^TMP("PSB1",$J) D EN^PSJBCMA2(DFN,PSBONX,1) I ^TMP("PSJ2",$J,0)'=1 M PSBOACTL=^TMP("PSJ2",$J) K ^TMP("PSJ2",$J)
  1.  ..I 'PSBODD F XX=0:1 Q:'$D(^TMP("PSB",$J,"GETADMIN",XX))  S (PSBADST,Z)=$G(^TMP("PSB",$J,"GETADMIN",XX)) D
  1.  ...D MISSED^PSBOMM2(Z,.PSBEDIT,PSBSTRT)
  1.  ..I PSBODD F XX=0:1 Q:'$D(PSBADST(XX))  S XXX=$O(PSBADST(XX,"")) S (PSBADST,Z)=PSBADST(XX,XXX) D
  1.  ...I Z]"" D MISSED^PSBOMM2(Z,.PSBEDIT,XXX)
  1.  .K PSBHDDT,PSBUNHD,^TMP("PSB1",$J)
  1.  .I PSBSCHT="O" D  Q
  1.  ..Q:PSBOSTS="N"
  1.  ..Q:PSBNGF
  1.  ..Q:PSBSM
  1.  ..Q:(PSBOSP=PSBOST)&(PSBOCRIT'["E")
  1.  ..Q:PSBOST'<PSBSTOP
  1.  ..S PSBDT="*** ONE-TIME ***"
  1.  ..S (PSBSTXP(PSBONX,$$DTFMT^PSBOMM2(PSBOSP)),PSBSTXT(PSBONX,$$DTFMT^PSBOMM2(PSBOST)))=""
  1.  ..S (PSBG,X,Y,PSBXSTS)="" K PSBEXST
  1.  ..F  S X=$O(^PSB(53.79,"AOIP",DFN,PSBOIT,X),-1) Q:'X  D
  1.  ...F  S Y=$O(^PSB(53.79,"AOIP",DFN,PSBOIT,X,Y),-1) Q:'Y  D
  1.  ....S PSBXSTS=$P(^PSB(53.79,Y,0),U,9)
  1.  ....I $P(^PSB(53.79,Y,.1),U)=PSBONX,PSBXSTS'="N",PSBXSTS'="M" S PSBG=1,PSBG(PSBONX,Y)="",(X,Y)=0
  1.  ..I PSBG D PARTG1^PSBOMM2($O(PSBG(PSBONX,"")))
  1.  ..D NOW^%DTC
  1.  ..Q:(PSBOCRIT'[PSBOSTS)
  1.  ..S PSBS(DFN,PSBONX,$S(PSBOSTS="A":"Active",PSBOSTS="H":"On Hold",PSBOSTS="D":"DC'd",PSBOSTS="DE":"DC'd (Edit)",PSBOSTS="E":"Expired",PSBOSTS="O":"On Call",1:" * ERROR * "))=""
  1.  ..D:'PSBG!(PSBACRIT[$G(PSBXSTS,1))
  1.  ...S VAR=""
  1.  ...K ^TMP("PSJ2",$J),^TMP("PSB1",$J),PSBOACTL D EN^PSJBCMA2(DFN,PSBONX,1) I ^TMP("PSJ2",$J,0)'=1 D
  1.  ....M PSBOACTL=^TMP("PSJ2",$J)
  1.  ....D UDONE^PSBOMM2
  1.  ....I PSBFLAG=1 S VAR="(On Hold) "_$$DTFMT^PSBOMM2(PSBHDDT)
  1.  ....I PSBFLAG=2 S VAR="(On Hold) "_$$DTFMT^PSBOMM2(PSBHDDT)_"  (Off Hold) "_$$DTFMT^PSBOMM2(PSBUNHD)
  1.  ...I '$G(PSBEXST,0)!(PSBXSTS="M") S $P(^TMP("PSB",$J,DFN,"*** ONE-TIME ***",PSBOITX,PSBONX),U,1,4)=VAR
  1.  ...I $G(PSBEXST,0) D
  1.  ....S VAR1=$G(^TMP("PSB",$J,DFN,"*** ONE-TIME ***","* "_PSBOITX,PSBONX)) I VAR1]"" S $P(VAR1,U,1,4)=VAR_VAR1
  1.  ...K PSBHDDT,PSBUNHD,^TMP("PSB1",$J),PSBCNT
  1.  K PSBOACTL
  1.  Q
  1. PRINT ;
  1.  N PSBHDR,PSBDT,PSBOITX,PSBONX,DFN
  1.  K PSBNPG
  1.  S Y=$S($P(PSBRPT(.1),U,8)]"":$P(PSBRPT(.1),U,8),1:$P(PSBRPT(.1),U,6))
  1.  D:$P(PSBRPT(.1),U,1)="P"
  1.  .S PSBHDR(1)="MISSED MEDICATIONS REPORT for "_$$FMTE^XLFDT($P(PSBRPT(.1),U,6)+$P(PSBRPT(.1),U,7))_" to "_$$FMTE^XLFDT(Y+$P(PSBRPT(.1),U,9))
  1.  .S PSBHDR(2)="Order Status(es): --"
  1.  .F Y=5,8,7 I $P(PSBFUTR,U,Y) S $P(PSBHDR(2),": ",2)=$P(PSBHDR(2),": ",2)_$S(PSBHDR(2)["--":"",1:"/ ")_$P("^^^^Active^^Expired^DC'd^^^^^^^^^^",U,Y)_" " S PSBHDR(2)=$TR(PSBHDR(2),"-","")
  1.  .S PSBHDR(3)="Admin Status(es): --"
  1.  .F Y=16,17,18 I $P(PSBFUTR,U,Y) S $P(PSBHDR(3),": ",2)=$P(PSBHDR(3),": ",2)_$S(PSBHDR(3)["--":"",1:"/ ")_$P("^^^^^^^^^^^^^^^Missing Dose^Held^Refused",U,Y)_" " S PSBHDR(3)=$TR(PSBHDR(3),"-","")
  1.  .I PSBINCC S PSBHDR(4)="Include Comments/Reasons"
  1.  .S DFN=$P(PSBRPT(.1),U,2)
  1.  .W $$PTHDR()
  1.  .I $G(PSBEDIT) W !?7,"*Administration Times have been edited*"
  1.  .I $O(^TMP("PSB",$J,DFN,""))="" W !,"No Missed Medications Found",$$PTFTR^PSBOHDR() Q
  1.  .S PSBDT=""
  1.  .F  S PSBDT=$O(^TMP("PSB",$J,DFN,PSBDT)) Q:PSBDT=""  D
  1.  ..W !
  1.  ..S PSBOITX=""
  1.  ..F  S PSBOITX=$O(^TMP("PSB",$J,DFN,PSBDT,PSBOITX)) Q:PSBOITX=""  D
  1.  ...S PSBONX=""
  1.  ...F  S PSBONX=$O(^TMP("PSB",$J,DFN,PSBDT,PSBOITX,PSBONX)) Q:PSBONX=""  D
  1.  ....K VAR1,VAR2,VAR3,SP I $Y>(IOSL-9) W $$PTFTR^PSBOHDR(),$$PTHDR()
  1.  ....S VAR1=$G(^TMP("PSB",$J,DFN,PSBDT,PSBOITX,PSBONX))
  1.  ....S VAR2=$G(^TMP("PSB",$J,DFN,PSBDT,PSBOITX,PSBONX,"X"))
  1.  ....S VAR3=$G(^TMP("PSB",$J,DFN,PSBDT,PSBOITX,PSBONX,.3))
  1.  ....I PSBDT["ONE-TIME" D  Q
  1.  .....W !
  1.  .....W !,$O(PSBS(DFN,PSBONX,"")),?15,PSBDT,?43,PSBOITX,!
  1.  .....I VAR1]"" W ?43,VAR1 S SP=1
  1.  .....I VAR2]"" W:$G(SP) ! W ?43,VAR2
  1.  .....I VAR3]"" W !,$$WRAP^PSBO(43,80,VAR3)
  1.  .....W !,"Start Date/Time:  ",?18,$O(PSBSTXT(PSBONX,""))
  1.  .....W !,"Stop Date/Time:  ",?18,$O(PSBSTXP(PSBONX,""))
  1.  ....W !,$O(PSBS(DFN,PSBONX,"")),?15,$S(+PSBDT>0:$$DTFMT^PSBOMM2(PSBDT),1:PSBDT),?43,PSBOITX,?95,$O(PSBSTXP(PSBONX,"")),!
  1.  ....I VAR1]"" W ?43,VAR1 S SP=1
  1.  ....I VAR2]"" W:$G(SP) ! W ?43,VAR2
  1.  ....I VAR3]"" W !,$$WRAP^PSBO(43,80,VAR3)
  1.  .W $$PTFTR^PSBOHDR()
  1.  .Q
  1.  D:$P(PSBRPT(.1),U,1)="W"
  1.  .S PSBHDR(1)="MISSED MEDICATIONS REPORT for "_$$FMTE^XLFDT($P(PSBRPT(.1),U,6)+$P(PSBRPT(.1),U,7))_" to "_$$FMTE^XLFDT(Y+$P(PSBRPT(.1),U,9))
  1.  .S PSBHDR(2)="Order Status(es): --"
  1.  .F Y=5,7,8 I $P(PSBFUTR,U,Y) S $P(PSBHDR(2),": ",2)=$P(PSBHDR(2),": ",2)_$S(PSBHDR(2)["--":"",1:"/ ")_$P("^^^^Active^^Expired^DC'd^^^^^^^^^^",U,Y)_" " S PSBHDR(2)=$TR(PSBHDR(2),"-","")
  1.  .S PSBHDR(3)="Admin Status(es): --"
  1.  .F Y=16,17,18 I $P(PSBFUTR,U,Y) S $P(PSBHDR(3),": ",2)=$P(PSBHDR(3),": ",2)_$S(PSBHDR(3)["--":"",1:"/ ")_$P("^^^^^^^^^^^^^^^Missing Dose^Held^Refused",U,Y)_" " S PSBHDR(3)=$TR(PSBHDR(3),"-","")
  1.  .I PSBINCC S PSBHDR(4)="Include Comments/Reasons"
  1.  .S PSBWARD=$P(PSBRPT(.1),U,3)
  1.  .W $$WRDHDR()
  1.  .I '$O(^TMP("PSB",$J,0)) W !,"No Missed Medications Found" Q
  1.  .S PSBSORT=$P(PSBRPT(.1),U,5)
  1.  .F DFN=0:0 S DFN=$O(^TMP("PSB",$J,DFN)) Q:'DFN  D
  1.  ..S PSBDX=$S(PSBSORT="P":$P(^DPT(DFN,0),U),1:$G(^DPT(DFN,.1))_" "_$G(^(.101)))
  1.  ..S:PSBDX="" PSBDX=$P(^DPT(DFN,0),U)
  1.  ..S ^TMP("PSB",$J,"B",PSBDX,DFN)=""
  1.  .S PSBDX=""
  1.  .F  S PSBDX=$O(^TMP("PSB",$J,"B",PSBDX)) Q:PSBDX=""  D
  1.  ..F DFN=0:0 S DFN=$O(^TMP("PSB",$J,"B",PSBDX,DFN)) Q:'DFN  D
  1.  ...W !
  1.  ...S PSBDT=""
  1.  ...F  S PSBDT=$O(^TMP("PSB",$J,DFN,PSBDT)) Q:PSBDT=""  D
  1.  ....W !
  1.  ....W:PSBDT["ONE-TIME" !
  1.  ....S PSBOITX=""
  1.  ....F  S PSBOITX=$O(^TMP("PSB",$J,DFN,PSBDT,PSBOITX)) Q:PSBOITX=""  D
  1.  .....S PSBONX=""
  1.  .....F  S PSBONX=$O(^TMP("PSB",$J,DFN,PSBDT,PSBOITX,PSBONX)) Q:PSBONX=""  D
  1.  ......K VAR1,VAR2,VAR3,SP I $Y>(IOSL-9) W $$WRDHDR()
  1.  ......W !,$O(PSBS(DFN,PSBONX,"")),?15,$G(^DPT(DFN,.101),"**")  ;,?35,$P(^DPT(DFN,0),U)," (",$E($P(^(0),U,9),6,9),")"
  1.  ......; IHS/MSC/PLS - 02/22/07
  1.  ......W ?35,$P(^DPT(DFN,0),U)," (",$$PTID^PSBOML(DFN,1),")"
  1.  ......S VAR1=$G(^TMP("PSB",$J,DFN,PSBDT,PSBOITX,PSBONX))
  1.  ......S VAR2=$G(^TMP("PSB",$J,DFN,PSBDT,PSBOITX,PSBONX,"X"))
  1.  ......S VAR3=$G(^TMP("PSB",$J,DFN,PSBDT,PSBOITX,PSBONX,.3))
  1.  ......I PSBDT["ONE-TIME" D  Q
  1.  .......W !,PSBDT,?30,PSBOITX S SP=1
  1.  .......I VAR1]"" W !,?30,$P(VAR1,U,1) S SP=1
  1.  .......I VAR2]"" W:$G(SP) ! W ?30,VAR2
  1.  .......I VAR3]"" W !,$$WRAP^PSBO(30,95,VAR3)
  1.  .......W !,"Start Date/Time:  ",?18,$O(PSBSTXT(PSBONX,""))
  1.  .......W !,"Stop Date/Time:  ",?18,$O(PSBSTXP(PSBONX,""))
  1.  .......W !
  1.  ......W ?67,$S(+PSBDT>0:$$DTFMT^PSBOMM2(PSBDT),1:PSBDT),?85,PSBOITX S SP=1
  1.  ......I VAR1]"" W !,?50,VAR1 S SP=1
  1.  ......I VAR2]"" W:$G(SP) ! W ?50,VAR2
  1.  ......I VAR3]"" W !,$$WRAP^PSBO(50,75,VAR3)
  1.  Q
  1. WRDHDR() ;
  1.  D WARD^PSBOHDR(PSBWRD,.PSBHDR)
  1.  W !,"Order Status",?15,"Room-Bed",?35,"Patient",?67,"Admin Date/Time",?85,"Medication"
  1.  D LN1^PSBOMM2
  1.  Q ""
  1. PTHDR() ;
  1.  D PT^PSBOHDR(DFN,.PSBHDR)
  1.  W !,"Order Status",?15,"Administration Date/Time",?43,"Medication",?95,"Order Stop Date"
  1.  D LN1^PSBOMM2
  1.  Q ""