PSBVAR ;BIRMINGHAM/EFC-BCMA VARIANCE LOG FUNCTIONS ;03/06/16 3:06pm
;;3.0;BAR CODE MED ADMIN;*31,70,80,83*;Mar 2004;Build 89
;Per VHA Directive 2004-038, this routine should not be modified.
;
; Reference/IA
; ^DPT/10035
; ^DIC(42/10039
;
;*70 - alter DD trigger code so Clinic Orders do not update variances
;*83 - add new event to 53.78 var file code 4 Early/Late Remove and
; track this event.
;
EN ;
Q
;
CHKPRN(DFN,PSBMIN,PSBLOG) ;
Q:PSBMIN=""
Q:PSBMIN'>$$GET^XPAR("DIV","PSB ADMIN PRN EFFECT")
D ADD(.RESULTS,DFN,3,PSBMIN,"",PSBLOG)
Q
;
;CHECK^PSBVAR() calling point is used to create a new variance entry.
; Triggered by Order Administration Variance Field # .14 in the BCMA
; Medication Log File (#53.79).
;
CHECK(DFN,PSBMIN,PSBLOG) ;
Q:PSBMIN=""
N RESULTS,EV
; Checks the timing from the Med Log Entry X-Ref
S EV=$S(PSBACTN="RM":4,1:2) ;create EV var and pass into ADD *83
S PSBDRUG=$$GET1^DIQ(53.79,PSBLOG_",",.08,"I")
I PSBMIN<0 D:(PSBMIN*-1)>$$GET^XPAR("DIV","PSB ADMIN BEFORE") ADD(.RESULTS,DFN,EV,PSBMIN,PSBDRUG,PSBLOG)
I PSBMIN>0 D:PSBMIN>$$GET^XPAR("DIV","PSB ADMIN AFTER") ADD(.RESULTS,DFN,EV,PSBMIN,PSBDRUG,PSBLOG)
Q
;
ADD(RESULTS,DFN,PSBEVNT,PSBMIN,PSBDRUG,PSBLOG) ;
;
; DFN: Patient File (#2) Pointer
; PSBEVNT: Event Code (See DD for 53.78)
; PSBMIN: Minutes off of schedule (Optional)
; PSBDRUG: Drug File (#50) Pointer (Optional)
; PSBLOG: BCMA Med Log IEN (Optional)
;
;Do not create variance for below events:
; Med order with missing dose status.
; Clinic orders
;
I $G(PSBLOG),$P($G(^PSB(53.79,PSBLOG,0)),U,9)="M" Q
Q:($G(PSBCLIN)]"")!($G(PSBCLORD)]"") ;Clin Flags defined - PSBML *70
;
N PSBDT,PSBRB,PSBWRD,PSBXX
;
D EN^DDIOL("Filing Variance...")
D NOW^%DTC
L +(^PSB(53.78,0)):5 E S RESULTS(0)="-1^Variance Log Locked" Q
S PSBXX=$O(^PSB(53.78,"A"),-1)+1
S $P(^PSB(53.78,0),U,3)=PSBXX
S $P(^PSB(53.78,0),U,4)=$P(^PSB(53.78,0),U,4)+1
;
WARD ;Extract the ward and room/bed information.
;DFN is pre-defined.
S PSBRB=$P($G(^DPT(DFN,.101)),U)
S PSBRB=$S(PSBRB'="":PSBRB,1:"***")
S PSBWRD=$P($G(^DPT(DFN,.1)),U)
;Convert Ward Name to Ward IEN
I PSBWRD'="" D
. S PSBDT=%
. S PSBWRD=$$FIND1^DIC(42,"","X",PSBWRD,"","","ERR")
. S %=PSBDT ;reset after $$FIND1^DIC fileman call
S PSBWRD=$S($G(PSBWRD):PSBWRD,1:"***")
;
; Set Variance Entry
S ^PSB(53.78,PSBXX,0)=DFN_U_PSBRB_U_DUZ_U_%_U_PSBEVNT_U_$G(PSBMIN)_U_$G(PSBDRUG)_U_$G(PSBLOG)_U_PSBWRD
;
S ^PSB(53.78,"ADT",%,PSBXX)=""
S ^PSB(53.78,"B",DFN,PSBXX)=""
L -(^PSB(53.78,0))
S RESULTS(0)="1^Data Filed"
Q
;
; Unable to UPDATE^DIE WHILE IN UPDATE^DIE
W !,"Filing Variance..."
D EN^DDIOL("Filing Variance...")
N PSBVFDA,PSBVMSG,PSBVIEN
D VAL(.01,"`"_DFN) ; Patient Pointer
S Y=$G(^DPT(DFN,.1),"Unk Ward")_" "_$G(^DPT(DFN,.101),"Unk Bed")
D VAL(.02,Y) ; Patient Location
D VAL(.03,"`"_DUZ) ; New Person Pointer
D VAL(.04,"NOW") ; DT Entered
D VAL(.05,PSBEVNT) ; Event Code
D:$G(PSBMIN) VAL(.06,PSBMIN) ; Minutes Early/Late
D:$G(PSBDRUG) VAL(.07,"`"_PSBDRUG) ; Drug File Pointer
D:$G(PSBLOG) VAL(.08,"`"_PSBLOG)
; Call UPDATE^DIE and set Results(0)
D UPDATE^DIE("","PSBVFDA","PSBVIEN","PSBVMSG") ; PSBVFDA set into file 53.68, BCMA MEDICATION VARIANCE LOG at VAL+3
I $D(PSBVMSG) S RESULTS(0)="-1^"_PSBVMSG("DIERR",1)_": "_PSBVMSG("DIERR",1,"TEXT",1)
E S RESULTS(0)="1^Data Successfully Filed^"_PSBVIEN(1)
W !,RESULTS(0)
Q
;
VAL(PSBVFLD,PSBVVAL) ;
N PSBVRET
K ^TMP("DIERR",$J)
D VAL^DIE(53.78,"+1,",PSBVFLD,"F",PSBVVAL,.PSBVRET,"PSBVFDA")
I PSBVRET="^" F X=0:0 S X=$O(^TMP("DIERR",$J,X)) Q:'X S Y=^TMP("DIERR",$J,X)_": "_$G(^(X,"TEXT",1),"**"),RESULTS($O(RESULTS(""),-1)+1)="Data Validation Error: "_Y
K ^TMP("DIERR",$J)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSBVAR 3828 printed Apr 09, 2024@20:45:25 Page 2
PSBVAR ;BIRMINGHAM/EFC-BCMA VARIANCE LOG FUNCTIONS ;03/06/16 3:06pm
+1 ;;3.0;BAR CODE MED ADMIN;*31,70,80,83*;Mar 2004;Build 89
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; Reference/IA
+5 ; ^DPT/10035
+6 ; ^DIC(42/10039
+7 ;
+8 ;*70 - alter DD trigger code so Clinic Orders do not update variances
+9 ;*83 - add new event to 53.78 var file code 4 Early/Late Remove and
+10 ; track this event.
+11 ;
EN ;
+1 QUIT
+2 ;
CHKPRN(DFN,PSBMIN,PSBLOG) ;
+1 if PSBMIN=""
QUIT
+2 if PSBMIN'>$$GET^XPAR("DIV","PSB ADMIN PRN EFFECT")
QUIT
+3 DO ADD(.RESULTS,DFN,3,PSBMIN,"",PSBLOG)
+4 QUIT
+5 ;
+6 ;CHECK^PSBVAR() calling point is used to create a new variance entry.
+7 ; Triggered by Order Administration Variance Field # .14 in the BCMA
+8 ; Medication Log File (#53.79).
+9 ;
CHECK(DFN,PSBMIN,PSBLOG) ;
+1 if PSBMIN=""
QUIT
+2 NEW RESULTS,EV
+3 ; Checks the timing from the Med Log Entry X-Ref
+4 ;create EV var and pass into ADD *83
SET EV=$SELECT(PSBACTN="RM":4,1:2)
+5 SET PSBDRUG=$$GET1^DIQ(53.79,PSBLOG_",",.08,"I")
+6 IF PSBMIN<0
if (PSBMIN*-1)>$$GET^XPAR("DIV","PSB ADMIN BEFORE")
DO ADD(.RESULTS,DFN,EV,PSBMIN,PSBDRUG,PSBLOG)
+7 IF PSBMIN>0
if PSBMIN>$$GET^XPAR("DIV","PSB ADMIN AFTER")
DO ADD(.RESULTS,DFN,EV,PSBMIN,PSBDRUG,PSBLOG)
+8 QUIT
+9 ;
ADD(RESULTS,DFN,PSBEVNT,PSBMIN,PSBDRUG,PSBLOG) ;
+1 ;
+2 ; DFN: Patient File (#2) Pointer
+3 ; PSBEVNT: Event Code (See DD for 53.78)
+4 ; PSBMIN: Minutes off of schedule (Optional)
+5 ; PSBDRUG: Drug File (#50) Pointer (Optional)
+6 ; PSBLOG: BCMA Med Log IEN (Optional)
+7 ;
+8 ;Do not create variance for below events:
+9 ; Med order with missing dose status.
+10 ; Clinic orders
+11 ;
+12 IF $GET(PSBLOG)
IF $PIECE($GET(^PSB(53.79,PSBLOG,0)),U,9)="M"
QUIT
+13 ;Clin Flags defined - PSBML *70
if ($GET(PSBCLIN)]"")!($GET(PSBCLORD)]"")
QUIT
+14 ;
+15 NEW PSBDT,PSBRB,PSBWRD,PSBXX
+16 ;
+17 DO EN^DDIOL("Filing Variance...")
+18 DO NOW^%DTC
+19 LOCK +(^PSB(53.78,0)):5
IF '$TEST
SET RESULTS(0)="-1^Variance Log Locked"
QUIT
+20 SET PSBXX=$ORDER(^PSB(53.78,"A"),-1)+1
+21 SET $PIECE(^PSB(53.78,0),U,3)=PSBXX
+22 SET $PIECE(^PSB(53.78,0),U,4)=$PIECE(^PSB(53.78,0),U,4)+1
+23 ;
WARD ;Extract the ward and room/bed information.
+1 ;DFN is pre-defined.
+2 SET PSBRB=$PIECE($GET(^DPT(DFN,.101)),U)
+3 SET PSBRB=$SELECT(PSBRB'="":PSBRB,1:"***")
+4 SET PSBWRD=$PIECE($GET(^DPT(DFN,.1)),U)
+5 ;Convert Ward Name to Ward IEN
+6 IF PSBWRD'=""
Begin DoDot:1
+7 SET PSBDT=%
+8 SET PSBWRD=$$FIND1^DIC(42,"","X",PSBWRD,"","","ERR")
+9 ;reset after $$FIND1^DIC fileman call
SET %=PSBDT
End DoDot:1
+10 SET PSBWRD=$SELECT($GET(PSBWRD):PSBWRD,1:"***")
+11 ;
+12 ; Set Variance Entry
+13 SET ^PSB(53.78,PSBXX,0)=DFN_U_PSBRB_U_DUZ_U_%_U_PSBEVNT_U_$GET(PSBMIN)_U_$GET(PSBDRUG)_U_$GET(PSBLOG)_U_PSBWRD
+14 ;
+15 SET ^PSB(53.78,"ADT",%,PSBXX)=""
+16 SET ^PSB(53.78,"B",DFN,PSBXX)=""
+17 LOCK -(^PSB(53.78,0))
+18 SET RESULTS(0)="1^Data Filed"
+19 QUIT
+20 ;
+21 ; Unable to UPDATE^DIE WHILE IN UPDATE^DIE
+22 WRITE !,"Filing Variance..."
+23 DO EN^DDIOL("Filing Variance...")
+24 NEW PSBVFDA,PSBVMSG,PSBVIEN
+25 ; Patient Pointer
DO VAL(.01,"`"_DFN)
+26 SET Y=$GET(^DPT(DFN,.1),"Unk Ward")_" "_$GET(^DPT(DFN,.101),"Unk Bed")
+27 ; Patient Location
DO VAL(.02,Y)
+28 ; New Person Pointer
DO VAL(.03,"`"_DUZ)
+29 ; DT Entered
DO VAL(.04,"NOW")
+30 ; Event Code
DO VAL(.05,PSBEVNT)
+31 ; Minutes Early/Late
if $GET(PSBMIN)
DO VAL(.06,PSBMIN)
+32 ; Drug File Pointer
if $GET(PSBDRUG)
DO VAL(.07,"`"_PSBDRUG)
+33 if $GET(PSBLOG)
DO VAL(.08,"`"_PSBLOG)
+34 ; Call UPDATE^DIE and set Results(0)
+35 ; PSBVFDA set into file 53.68, BCMA MEDICATION VARIANCE LOG at VAL+3
DO UPDATE^DIE("","PSBVFDA","PSBVIEN","PSBVMSG")
+36 IF $DATA(PSBVMSG)
SET RESULTS(0)="-1^"_PSBVMSG("DIERR",1)_": "_PSBVMSG("DIERR",1,"TEXT",1)
+37 IF '$TEST
SET RESULTS(0)="1^Data Successfully Filed^"_PSBVIEN(1)
+38 WRITE !,RESULTS(0)
+39 QUIT
+40 ;
VAL(PSBVFLD,PSBVVAL) ;
+1 NEW PSBVRET
+2 KILL ^TMP("DIERR",$JOB)
+3 DO VAL^DIE(53.78,"+1,",PSBVFLD,"F",PSBVVAL,.PSBVRET,"PSBVFDA")
+4 IF PSBVRET="^"
FOR X=0:0
SET X=$ORDER(^TMP("DIERR",$JOB,X))
if 'X
QUIT
SET Y=^TMP("DIERR",$JOB,X)_": "_$GET(^(X,"TEXT",1),"**")
SET RESULTS($ORDER(RESULTS(""),-1)+1)="Data Validation Error: "_Y
+5 KILL ^TMP("DIERR",$JOB)
+6 QUIT
+7 ;
