| 1 | PSBPOIV ;BIRMINGHAM/EFC-IV PARAMETER VALIDATION ;Mar 2004
|
|---|
| 2 | ;;3.0;BAR CODE MED ADMIN;**2**;Mar 2004;Build 22
|
|---|
| 3 | ;;Per VHA Directive 2004-038 (or future revisions regarding same), this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ; Reference/IA
|
|---|
| 6 | ; ^DIC(42/2440
|
|---|
| 7 | ; EN^PSJBCMA2/2830
|
|---|
| 8 | ; VADPT/10061
|
|---|
| 9 | ;
|
|---|
| 10 | ;
|
|---|
| 11 | EN(PSBDFN,PSBORD) ;
|
|---|
| 12 | ;
|
|---|
| 13 | S DFN=PSBDFN,(PSBMI,PSBMW,PSBMWC,PSBMAUD)=0,(PSBMIDT,PSBMIM)="",PSBONXS=PSBORD_"^"
|
|---|
| 14 | K ^TMP("PSBAR",$J) S ^TMP("PSBAR",$J,"W",0)=0
|
|---|
| 15 | D CLEAN^PSBVT,PSJ1^PSBVT(DFN,PSBORD)
|
|---|
| 16 | ; get IV parameters for the current ward
|
|---|
| 17 | S PSBCSTR="^ADDITIVE^STRENGTH^BOTTLE^SOLUTION^VOLUME^INFUSION RATE^MED ROUTE^SCHEDULE^ADMIN TIME^REMARKS^OTHER PRINT INFO^PROVIDER^START DATE/TIME^STOP DATE/TIME^PROVIDER COMMENTS"
|
|---|
| 18 | D INP^VADPT S PSBWARD=$P(VAIN(4),"^"),PSBWDIV=PSBWARD D KVAR^VADPT
|
|---|
| 19 | I $G(PSBWARD)'="",$D(^PSB(53.66,"B",PSBWARD)) D ; if IV paramaters defined for ward use them
|
|---|
| 20 | .S PSBWARD=$O(^PSB(53.66,"B",PSBWARD,""))
|
|---|
| 21 | .S:$D(^PSB(53.66,PSBWARD,1,"B",PSBIVT)) PSBIVPAR=^PSB(53.66,PSBWARD,1,$O(^PSB(53.66,PSBWARD,1,"B",PSBIVT,""),-1),0)
|
|---|
| 22 | I '$D(PSBIVPAR) S PSBIVPAR=PSBIVT D ; if IV parameters not defined for ward get defaults for division
|
|---|
| 23 | .D:$D(PSBWDIV) ; Get the appropriate DIV for ward and DIVISIONAL IV PARAMETERS
|
|---|
| 24 | ..S PSBWDIV=$$GET1^DIQ(42,PSBWDIV_",",.015,"I")
|
|---|
| 25 | ..I $G(PSBWDIV)']"" S PSBWDIV="DIV"
|
|---|
| 26 | ..E S PSBWDIV=$P($$SITE^VASITE(DT,PSBWDIV),U,1),PSBWDIV="DIV.`"_PSBWDIV
|
|---|
| 27 | ..F X=2:1 Q:$P(PSBCSTR,U,X)="" S PSBIVPAR=PSBIVPAR_U_$P($P($$GET^XPAR(PSBWDIV,"PSBIV "_$P(PSBCSTR,U,X),PSBIVT,"B"),U,2),"-",1)
|
|---|
| 28 | ..K PSBWDIV ; Kill temp variable.
|
|---|
| 29 | F PSBC1=1:1 Q:$P(PSBONXS,U,PSBC1)="" D ; process all orders
|
|---|
| 30 | .D CLEAN^PSBVT,PSJ1^PSBVT(DFN,$P(PSBONXS,U,PSBC1))
|
|---|
| 31 | .K PSBPONX2 I $G(PSBPONX)]"",$G(PSBPONX)["P" S PSBPONX2=PSBPONX D ; Must compare "active" orders for changes made - look beyond "pendings"
|
|---|
| 32 | ..F D CLEAN^PSBVT,PSJ1^PSBVT(DFN,PSBPONX2) S PSBPONX2=PSBPONX Q:(PSBPONX2="")!(PSBPONX2'["P") ;
|
|---|
| 33 | ..D CLEAN^PSBVT,PSJ1^PSBVT(DFN,$P(PSBONXS,U,PSBC1)) ; Refresh data
|
|---|
| 34 | ..S:$D(PSBPONX2) PSBPONX=PSBPONX2 K PSBPONX2
|
|---|
| 35 | .Q:($L(U_PSBONXS,U_PSBPONX_U)-1)>0
|
|---|
| 36 | .I $G(PSBPONX)]"" S PSBONXS=PSBONXS_PSBPONX_U
|
|---|
| 37 | .K ^TMP("PSJ2",$J) S PSBMAUD=0 D EN^PSJBCMA2(PSBDFN,PSBONX,1) ; check IV parameters against activity log for this order when no "I"nvalid message
|
|---|
| 38 | .I PSBMI=0 F X=1:1 Q:'$D(^TMP("PSJ2",$J,X)) S PSBCHKV=U_$P(^TMP("PSJ2",$J,X,1),U,3)_U I PSBCSTR[PSBCHKV D MSG(PSBCHKV,$P(^TMP("PSJ2",$J,X,1),U,1)) S PSBMAUD=1
|
|---|
| 39 | .K ^TMP("PSJ2",$J)
|
|---|
| 40 | .I PSBMI=0,$G(PSBPONX)]"" D SAVEPAR,CHKORD ; check IV parameters against previous order when no "I"nvalid message
|
|---|
| 41 | .D CLEAN^PSBVT,PSJ1^PSBVT(DFN,$P(PSBONXS,U,PSBC1)) ; restore variable for this order
|
|---|
| 42 | .; okay - we have invalids and warnings through this order so process bags for this order
|
|---|
| 43 | .I '$D(PSBUIDA) Q ; got errors and warning but no bags printed for this order - go to the next
|
|---|
| 44 | .S PSBUID="" F S PSBUID=$O(PSBUIDA(PSBUID),-1) Q:PSBUID="" D
|
|---|
| 45 | ..F PSBC2=1:1 S PSBMONX=$P(PSBONXS,U,PSBC2) Q:PSBMONX="" D ; check if bag is in 53.79
|
|---|
| 46 | ...I $D(^PSB(53.79,"AUID",PSBDFN,PSBMONX,PSBUID)) D
|
|---|
| 47 | ....S PSBIEN=$O(^PSB(53.79,"AUID",PSBDFN,PSBMONX,PSBUID,""))
|
|---|
| 48 | ....S PSBPDT=$P(PSBLBLA(PSBUID),U,1),PSBLSTS=$P(PSBLBLA(PSBUID),3)
|
|---|
| 49 | ....S $P(X,U,2)=$P(^PSB(53.79,PSBIEN,0),U,9) ; add action status
|
|---|
| 50 | ....S $P(X,U,3)=$P(^PSB(53.79,PSBIEN,0),U,6) ; add action date/time
|
|---|
| 51 | ....S $P(X,U,4)=$P(^PSB(53.79,PSBIEN,.1),U,1) ; add order ID was administered for
|
|---|
| 52 | ..S $P(X,U,5)=PSBONX ; add order ID was printed for
|
|---|
| 53 | ..S $P(X,U,6)=PSBOSTS ; add order status
|
|---|
| 54 | ..S $P(X,U,7)=$P(PSBLBLA(PSBUID),U,1) ; add date/time ID was printed
|
|---|
| 55 | ..S $P(X,U,8)=$P(PSBLBLA(PSBUID),U,3) ; add lable status from pharmacy
|
|---|
| 56 | ..S $P(X,U,9)="" ; 9 open for later development
|
|---|
| 57 | ..S $P(X,U,10)=PSBUIDA(PSBUID) ; add return from PSJ1
|
|---|
| 58 | ..D BWAR
|
|---|
| 59 | ..I PSBMW=1 S PSBMWS="W;" F I=1:1:^TMP("PSBAR",$J,"W",0) D S $P(X,U,1)=$P(PSBMWS,";",1,$L(PSBMWS,";")-1)
|
|---|
| 60 | ...I $P(PSBLBLA(PSBUID),U,1)'>$P(^TMP("PSBAR",$J,"W",I),U,2) D
|
|---|
| 61 | ....S:(PSBONX=$P(PSBONXS,U,1))&(PSBMAUD=1) PSBMWS=PSBMWS_I_";"
|
|---|
| 62 | ....S:PSBONX'=$P(PSBONXS,U,1) PSBMWS=PSBMWS_I_";"
|
|---|
| 63 | ..I PSBMIDT'="",$P(PSBLBLA(PSBUID),U,1)<PSBMIDT D
|
|---|
| 64 | ...S:(PSBONX=$P(PSBONXS,U,1))&(PSBMAUD=1) $P(X,U,1)="I"
|
|---|
| 65 | ...S:(PSBONX'=$P(PSBONXS,U,1)) $P(X,U,1)="I"
|
|---|
| 66 | ..S ^TMP("PSBAR",$J,PSBUID)=X K X
|
|---|
| 67 | D CLEAN^PSBVT
|
|---|
| 68 | K PSBC1,PSBC2,PSBSCHV,PSBCSTR,PSBIVPAR,PSBMI,PSBMIDT,PSBMIM,PSBMONX,PSBMW,PSBSPAR,PSBUID,PSBWARD
|
|---|
| 69 | K PSBADA,PSBSOLA,PSBOTMP
|
|---|
| 70 | I ^TMP("PSBAR",$J,"W",0)=0 K ^TMP("PSBAR",$J,"W",0)
|
|---|
| 71 | D PSJ1^PSBVT(DFN,PSBORD) ; restore variables for calling order
|
|---|
| 72 | Q
|
|---|
| 73 | ;
|
|---|
| 74 | SAVEPAR ; save parameters from current order
|
|---|
| 75 | K PSBOTMP
|
|---|
| 76 | I $D(PSBADA) M PSBOTMP("ADD")=PSBADA E S PSBOTMP("ADD")="" ; additive, strength, bottle
|
|---|
| 77 | I $D(PSBSOLA) M PSBOTMP("SOL")=PSBSOLA E S PSBOTMP("SOL")="" ; solution, volume,
|
|---|
| 78 | K PSBADA,PSBSOLA
|
|---|
| 79 | S PSBOTMP("INFUSION RATE")=$G(PSBIFR),PSBOTMP("MED ROUTE")=$G(PSBMR)
|
|---|
| 80 | S PSBOTMP("SCHEDULE")=$G(PSBSCH),PSBOTMP("ADMIN TIME")=$G(PSBADST)
|
|---|
| 81 | S PSBOTMP("REMARKS")=$G(PSBRMRK),PSBOTMP("OTHER PRINT INFO")=$G(PSBOTXT)
|
|---|
| 82 | S PSBOTMP("PROVIDER")=PSBMD,PSBOTMP("START DATE/TIME")=PSBOST
|
|---|
| 83 | S PSBOTMP("STOP DATE/TIME")=PSBOSP
|
|---|
| 84 | D CLEAN^PSBVT,PSJ1^PSBVT(DFN,$P(PSBONXS,U,PSBC1+1)) ; setup previous order variables
|
|---|
| 85 | Q
|
|---|
| 86 | ;
|
|---|
| 87 | CHKORD ; check previous order against current order
|
|---|
| 88 | I $D(PSBADA)!($D(PSBOTMP("ADD"))) D CHKADD Q:PSBMI=1
|
|---|
| 89 | I $D(PSBSOLA)!($D(PSBOTMP("SOL"))) D CHKSOL Q:PSBMI=1
|
|---|
| 90 | I PSBIFR'=PSBOTMP("INFUSION RATE") D MSG("INFUSION RATE",PSBOSP) Q:PSBMI=1
|
|---|
| 91 | I PSBMR'=PSBOTMP("MED ROUTE") D MSG("MED ROUTE",PSBOSP) Q:PSBMI=1
|
|---|
| 92 | I PSBSCH'=PSBOTMP("SCHEDULE") D MSG("SCHEDULE",PSBOSP) Q:PSBMI=1
|
|---|
| 93 | I PSBADST'=PSBOTMP("ADMIN TIME") D MSG("ADMIN TIME",PSBOSP) Q:PSBMI=1
|
|---|
| 94 | I PSBRMRK'=PSBOTMP("REMARKS") D MSG("REMARKS",PSBOSP) Q:PSBMI=1
|
|---|
| 95 | I PSBOTXT'=PSBOTMP("OTHER PRINT INFO") D MSG("OTHER PRINT INFO",PSBOSP) Q:PSBMI=1
|
|---|
| 96 | I PSBMD'=PSBOTMP("PROVIDER") D MSG("PROVIDER",PSBOSP) Q:PSBMI=1
|
|---|
| 97 | I $E(PSBOST,1,10)'=$E(PSBOTMP("START DATE/TIME"),1,10) D MSG("START DATE/TIME",PSBOSP) Q:PSBMI=1
|
|---|
| 98 | I $E(PSBOSP,1,10)'=$E(PSBOTMP("STOP DATE/TIME"),1,10) D MSG("STOP DATE/TIME",PSBOSP)
|
|---|
| 99 | Q
|
|---|
| 100 | CHKADD ;
|
|---|
| 101 | N X,Y
|
|---|
| 102 | I '$D(PSBADA),'$D(PSBOTMP("ADD")) Q ; no additives
|
|---|
| 103 | I $O(PSBADA(""),-1)>$O(PSBOTMP("ADD",""),-1) D MSG("ADDITIVE",PSBOSP) Q ;previous order has addtives not in current order
|
|---|
| 104 | I $O(PSBADA(""),-1)<$O(PSBOTMP("ADD",""),-1) D MSG("ADDITIVE",PSBOSP) Q ;previous order missing additives in current order
|
|---|
| 105 | S X="" F S X=$O(PSBADA(X)) Q:X="" D Q ; check that additives, strength, and bottle are the same
|
|---|
| 106 | .I PSBADA(X)=PSBOTMP("ADD",X) Q ; everything the same
|
|---|
| 107 | .I $P(PSBADA(X),U,2)'=$P(PSBOTMP("ADD",X),U,2) D MSG("ADDITIVE",PSBOSP) Q
|
|---|
| 108 | .I $P(PSBADA(X),U,4)'=$P(PSBOTMP("ADD",X),U,4) D MSG("STRENGTH",PSBOSP) Q
|
|---|
| 109 | Q
|
|---|
| 110 | ;
|
|---|
| 111 | CHKSOL ;
|
|---|
| 112 | N X,Y
|
|---|
| 113 | I '$D(PSBSOLA),'$D(PSBOTMP("SOL")) Q ; no solutions
|
|---|
| 114 | I $O(PSBSOLA(""),-1)>$O(PSBOTMP("SOL",""),-1) D MSG("SOLUTION",PSBOSP) Q ;previous order has solutions not in current order
|
|---|
| 115 | I $O(PSBSOLA(""),-1)<$O(PSBOTMP("SOL",""),-1) D MSG("SOLUTION",PSBOSP) Q ;previous order missing solutions in current order
|
|---|
| 116 | S X="" F S X=$O(PSBSOLA(X)) Q:X="" D Q ; check that solutions volume are the same
|
|---|
| 117 | .I PSBSOLA(X)=PSBOTMP("SOL",X) Q ; everything the same
|
|---|
| 118 | .I $P(PSBSOLA(X),U,2)'=$P(PSBOTMP("SOL",X),U,2) D MSG("SOLUTION",PSBOSP) Q
|
|---|
| 119 | .I $P(PSBSOLA(X),U,4)'=$P(PSBOTMP("SOL",X),U,4) D MSG("VOLUME",PSBOSP) Q
|
|---|
| 120 | Q
|
|---|
| 121 | ;
|
|---|
| 122 | BWAR ;
|
|---|
| 123 | N X,Y,Z,PSBONX
|
|---|
| 124 | S X=^TMP("PSBAR",$J,"W",0)+1
|
|---|
| 125 | S Z="" F Z=1:1 S PSBONX=$P(PSBONXS,U,Z) Q:$G(PSBONX)="" D ; Display "Warning"s for changes
|
|---|
| 126 | .I '$D(PSBMWAR(PSBONX)) Q
|
|---|
| 127 | .S Y="" F S Y=$O(PSBMWAR(PSBONX,Y)) Q:Y'?.N1".".N D
|
|---|
| 128 | ..S Z="",PSBYS="" F S Z=$O(PSBMWAR(PSBONX,Y,Z)) Q:Z="" S PSBYS=PSBYS_Z_";"
|
|---|
| 129 | ..S PSBYS=$P(PSBYS,";",1,$L(PSBYS,";")-1)
|
|---|
| 130 | ..S ^TMP("PSBAR",$J,"W",X)=PSBONX_U_Y_U_"2^The "_PSBYS_" was changed on",^TMP("PSBAR",$J,"W",0)=X,X=X+1
|
|---|
| 131 | .K PSBMWAR(PSBONX)
|
|---|
| 132 | Q
|
|---|
| 133 | ;
|
|---|
| 134 | MSG(PSBMVAR,PSBDATE) ;
|
|---|
| 135 | I PSBMI=1 Q ;already have an invalid don't need anymore
|
|---|
| 136 | F Y=1:1 S PSBSPAR=$P(PSBCSTR,U,Y) I PSBSPAR=$TR(PSBMVAR,"^") D Q
|
|---|
| 137 | .I $P(PSBIVPAR,U,Y)="W" D
|
|---|
| 138 | ..S PSBMVAR=$TR(PSBMVAR,"^")
|
|---|
| 139 | ..I PSBMW=0 S PSBMW=1
|
|---|
| 140 | ..S PSBMWC=PSBMWC+1,PSBMWM="2^The "_PSBSPAR_" has been changed."
|
|---|
| 141 | ..I $D(PSBMWAR(PSBONX,PSBMVAR)) S PSBOLDT=$O(PSBMWAR(PSBONX,PSBMVAR,"")) I PSBOLDT<$E(PSBDATE,1,12) K PSBMWAR(PSBONX,PSBMVAR,PSBOLDT)
|
|---|
| 142 | ..S PSBMWAR(PSBONX,PSBMVAR,$E(PSBDATE,1,12))=""
|
|---|
| 143 | ..S PSBMWAR(PSBONX,$E(PSBDATE,1,12),PSBMVAR)=""
|
|---|
| 144 | .I $P(PSBIVPAR,U,Y)="I" S PSBMI=1,PSBMIDT=PSBDATE,PSBMIM="-1^IV invalid "_PSBSPAR_".",^TMP("PSBAR",$J,"I")=PSBONX_U_PSBMIDT_U_PSBMIM
|
|---|
| 145 | Q
|
|---|
