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

PSBVDLTB.m

Go to the documentation of this file.
  1. PSBVDLTB ;BIRMINGHAM/EFC-BCMA VIRTUAL DUE LIST FUNCTIONS (CONT) ;03/06/16 3:06pm
  1. ;;3.0;BAR CODE MED ADMIN;**3,4,16,68,70,78,83,92,147**;Mar 2004;Build 1
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ; Reference/IA
  1. ; EN^PSJBCMA/2828
  1. ; IN5^VADPT/10061
  1. ; DEM^VADPT/10061
  1. ; INP^VADPT/10061
  1. ; $$FMADD^XLFDT/10103
  1. ; $$GET^XPAR/2263
  1. ;
  1. ;*68 - add new parameter to use new SI/OPI word processing fields
  1. ;*70 - add Clinic order request IN param flag (true/false 0/1).
  1. ; also add to return array(1) 6th, 7th piece = IM & CO ord count
  1. ; also add to return array order line 32 piece, Clinic name for
  1. ; CO orders.
  1. ;*83 - cleanup variables here instead of in each tab rtn
  1. ;
  1. ; ** Warning: PSBSIOPI & PSBCLINORD will be used as global variables
  1. ; for all down stream calls from this RPC tag.
  1. ;
  1. RPC(RESULTS,DFN,PSBTAB,PSBDT,PSBSIOPI,PSBCLINORD,PSBSRCHDIR) ;
  1. N PSBCNT,PSBORDCNT,PSBPATCH,PSBINFUS,PSBIVSTP,PSBA ;*70
  1. N PSBNOW ;*83
  1. K RESULTS,^TMP("PSB",$J),^TMP("PSJ",$J)
  1. S PSBSIOPI=+$G(PSBSIOPI) ;*68 init to 0 if not present or 1 if sent
  1. S PSBCLINORD=+$G(PSBCLINORD) ;*70 set to 0 if NULL
  1. S PSBSRCHDIR=$$UP^XLFSTR($G(PSBSRCHDIR)) ;*70 set to NULL/upper
  1. S PSBTRFL=0
  1. S RESULTS=$NAME(^TMP("PSB",$J,PSBTAB))
  1. ;
  1. Q:$$DECEASED(DFN)
  1. ;
  1. ;Set date & time window varaibles
  1. ;
  1. S PSBNOW=+$G(PSBDT)
  1. I 'PSBNOW D NOW^%DTC S PSBNOW=+$E(%,1,10)
  1. S PSBDT=$P(PSBNOW,".",1)
  1. ;
  1. ;check if fast search requested and valid direction passed, then
  1. ; get the next date tha order data exists and Not Given
  1. I PSBCLINORD,(PSBSRCHDIR="B")!(PSBSRCHDIR="F") D
  1. . N PSBSRCHDT,SRCHDIR
  1. . S SRCHDIR=$S(PSBSRCHDIR="B":-1,1:1)
  1. . S PSBSRCHDT=$$FINDORD^PSBVDLU1(SRCHDIR,DFN,PSBDT,PSBTAB)
  1. . S:PSBSRCHDT'=-1 (PSBNOW,PSBDT)=PSBSRCHDT
  1. ;
  1. ;*70 - if CO, set window of time to the entire day
  1. I PSBCLINORD D
  1. .S PSBWBEG=$P(PSBDT,".")_".0000"
  1. .S PSBWEND=$P(PSBDT,".")_".2400"
  1. E D
  1. .S PSBWBEG=$$FMADD^XLFDT(PSBNOW,"",-12)
  1. .S PSBWEND=$$FMADD^XLFDT(PSBNOW,"",12)
  1. ;
  1. ;Create variable for valid order start date/time against admin window
  1. S PSBWADM=$$GET^XPAR("DIV","PSB ADMIN BEFORE")
  1. S:PSBCLINORD PSBWADM=99999
  1. D NOW^%DTC S PSBWADM=$$FMADD^XLFDT(%,"","",+PSBWADM) ; correction for start date issue, PSB*3*78
  1. ;
  1. ;Use last movement for API
  1. S VAIP("D")="LAST" D IN5^VADPT S PSBTRDT=+VAIP(3),PSBTRTYP=$P(VAIP(2),U,2),PSBMVTYP=$P(VAIP(4),U,2) K VAIP
  1. ;
  1. ;Get patient transfer notification timeframe to determine pop-up box
  1. S PSBPTTR=$$GET^XPAR("DIV","PSB PATIENT TRANSFER") I PSBPTTR="" S PSBPTTR=72
  1. D NOW^%DTC S PSBNTDT=$$FMADD^XLFDT(%,"",-PSBPTTR) I PSBNTDT'>PSBTRDT S PSBTRFL=1
  1. ;
  1. ;Passing PSBDT as 3rd parameter turns off the V.1.0 One-Time lookback
  1. ;*70 check if IM or CO orders exists for mode lights
  1. S PSBORDCNT=$$MODELITE^PSBVDLU1 ;mode lights
  1. S PSBPATCH=$$PATCHON^PSBVDLU1(DFN,.PSBA) ;patch on light
  1. S:PSBA("I") $P(PSBORDCNT,U)=1 S:PSBA("C") $P(PSBORDCNT,U,2)=1
  1. S PSBIVSTP=$$STOPPED^PSBVDLU1(DFN,.PSBA) ;IV stopped light
  1. S:PSBA("I") $P(PSBORDCNT,U)=1 S:PSBA("C") $P(PSBORDCNT,U,2)=1
  1. S PSBINFUS=$$INFUSING^PSBVDLU1(DFN,.PSBA) ;IV infusing light
  1. S:PSBA("I") $P(PSBORDCNT,U)=1 S:PSBA("C") $P(PSBORDCNT,U,2)=1
  1. ;
  1. ; Setup the ^TMP("PSJ",$J global for use below
  1. K ^TMP("PSJ",$J)
  1. K PSJ ;P147
  1. D EN^PSJBCMA(DFN,PSBNOW,PSBDT)
  1. D:PSBCLINORD INCLUDCO^PSBVDLU1
  1. D:'PSBCLINORD REMOVECO^PSBVDLU1
  1. ;
  1. ;initialize tabs
  1. D TABINIT
  1. ;
  1. ;The following calls must be made in the order below since the ^TMP global is reused
  1. D EN^PSBVDLUD(DFN,PSBDT)
  1. D EN^PSBVDLPB(DFN,PSBDT)
  1. D EN^PSBVDLIV(DFN,PSBDT)
  1. ; adding a special check for lighting the Unit Dose Tab light.
  1. ; Patches sent to GUI via this API will send both IM and CO patches
  1. ; that are expired/dc'd and are still on the patient. So there is a
  1. ; a scenario when a unit dose patch can be on TMP global and it is
  1. ; the only order in TMP but was for a different mode than currently
  1. ; viewing. In this case CNT will = 0 and use it to turn on the light
  1. N CNT,QQ,NODE S CNT=0
  1. I $D(^TMP("PSB",$J,"UDTAB",2))>0 D ;unit dose tab check *70
  1. . F QQ=2:1 Q:'$D(^TMP("PSB",$J,"UDTAB",QQ)) D Q:CNT
  1. .. S NODE=^TMP("PSB",$J,"UDTAB",QQ)
  1. .. I $L(NODE,U)>27,$P(NODE,U,2)?.N1A D
  1. ... ; first order found Activ per correct mode, then quit with cnt=1
  1. ... I PSBCLINORD,$P(NODE,U,33),($P(NODE,U,22)="A"!($P(NODE,U,22)="H")!($P(NODE,U,22)="R")) S CNT=1 Q
  1. ... I 'PSBCLINORD,'$P(NODE,U,33),($P(NODE,U,22)="A"!($P(NODE,U,22)="H")!($P(NODE,U,22)="R")) S CNT=1 Q
  1. ... Q:'$P(NODE,U,28) ;not a given patch
  1. ... I PSBCLINORD,$P($P(NODE,U,26),".")'>DT,'$P(NODE,U,33) Q
  1. ... I 'PSBCLINORD,$P($P(NODE,U,26),".")'>DT,$P(NODE,U,33) Q
  1. ... S CNT=1
  1. S $P(PSBATAB,U,1)=$S(CNT:1,1:0) ;*70 use CNT for UD light
  1. S $P(PSBATAB,U,2)=$S($D(^TMP("PSB",$J,"PBTAB",2))>0:1,1:0)
  1. S $P(PSBATAB,U,3)=$S($D(^TMP("PSB",$J,"IVTAB",2))>0:1,1:0)
  1. S:PSBTAB="UDTAB" PSBCNT=$O(^TMP("PSB",$J,"UDTAB",""),-1)
  1. S:PSBTAB="IVTAB" PSBCNT=$O(^TMP("PSB",$J,"IVTAB",""),-1)
  1. S:PSBTAB="PBTAB" PSBCNT=$O(^TMP("PSB",$J,"PBTAB",""),-1)
  1. ;
  1. I PSBTAB="NO TAB" D
  1. .S ^TMP("PSB",$J,PSBTAB,0)=1
  1. .S ^TMP("PSB",$J,PSBTAB,1)=PSBATAB
  1. .S $P(^TMP("PSB",$J,PSBTAB,1),U,5,6)=PSBORDCNT ;*70 Cvsht offset cnt
  1. .S $P(^TMP("PSB",$J,PSBTAB,1),U,7)=PSBINFUS ;*70 IV infuse light
  1. .S $P(^TMP("PSB",$J,PSBTAB,1),U,8)=PSBIVSTP ;*70 IV stop light
  1. .S $P(^TMP("PSB",$J,PSBTAB,1),U,9)=PSBPATCH ;*70 patch light
  1. E D
  1. .I $G(PSBCNT)>0 S ^TMP("PSB",$J,PSBTAB,0)=PSBCNT
  1. .I $G(PSBCNT)>1 S ^TMP("PSB",$J,PSBTAB,1)=PSBATAB_U_$S(PSBTRFL:PSBTRTYP_U_PSBMVTYP,1:"")
  1. .I $G(PSBCNT)'>1 S ^TMP("PSB",$J,PSBTAB,1)=PSBATAB
  1. .S $P(^TMP("PSB",$J,PSBTAB,1),U,6,7)=PSBORDCNT ;*70 Tabs Ord cnt
  1. .S $P(^TMP("PSB",$J,PSBTAB,1),U,8)=PSBINFUS ;*70 IV infuse light
  1. .S $P(^TMP("PSB",$J,PSBTAB,1),U,9)=PSBIVSTP ;*70 IV stop light
  1. .S $P(^TMP("PSB",$J,PSBTAB,1),U,10)=PSBPATCH ;*70 patch light
  1. ;
  1. F X="UDTAB","PBTAB","IVTAB" I X'=PSBTAB K ^TMP("PSB",$J,X)
  1. D CLEAN^PSBVT
  1. K ^TMP("PSJ",$J),PSBATAB,PSBWADM,PSBWBEG,PSBWEND,PSBNOW,PSBTRDT,PSBPTTR,PSBTRFL,PSBNTDT,PSBTRTYP,PSBMVTYP ;*83
  1. Q
  1. ;
  1. TABINIT ;
  1. F PSBX="UDTAB","PBTAB","IVTAB" D
  1. .K ^TMP("PSB",$J,PSBX)
  1. .S ^TMP("PSB",$J,PSBX,0)=1
  1. .S ^TMP("PSB",$J,PSBX,1)="-1^No Administration(s) due at this time." Q
  1. ;
  1. DECEASED(DFN) ; Patient Deceased?
  1. ;
  1. S DECEASED=0
  1. D DEM^VADPT I VADM(6)]"" S DECEASED=1 K VADM D Q DECEASED
  1. .F PSBX="UDTAB","PBTAB","IVTAB","NO TAB" D
  1. ..K ^TMP("PSB",$J,PSBX)
  1. ..S ^TMP("PSB",$J,PSBX,0)=1,^TMP("PSB",$J,PSBX,1)="0^0^0^-1^A ""DATE OF DEATH"" has been logged for this patient."
  1. Q DECEASED