133 lines
9.4 KiB
Mathematica
133 lines
9.4 KiB
Mathematica
PSBCHKIV ;BIRMINGHAM/TEJ-BCMA CHECK IV ROUTINE ;Mar 2004
|
|
;;3.0;BAR CODE MED ADMIN;**16**;Mar 2004
|
|
;
|
|
;This routine will provide "change" details for infus or stopped IV bags.
|
|
;
|
|
; Reference/IA
|
|
; EN^PSJBCMA1/2829
|
|
; EN^PSJBCMA2/2830
|
|
;
|
|
RPC(RESULTS,DFN,ORDIV) ;
|
|
I '$D(ORDIV) S RESULTS(0)=0 Q
|
|
N PSBGNODE,PSBPIN,PSBXX,PSBX,PSBBUIDS,PSBBUID K PSBBAGD,PSBADDS,PSBSOLS,RESULTS
|
|
D NOW^%DTC S X1=X,X2=-3 D C^%DTC S PSBDT=X
|
|
S PSBPIN=DFN
|
|
S Z="" F S Z=$O(ORDIV(Z)) Q:Z="" D
|
|
.D GETORD^PSBCHIVH(ORDIV(Z))
|
|
.F S=1:1 Q:$P(PSBONXSB,"^",S)="" D
|
|
..S PSBORD=$P(PSBONXSB,"^",S)
|
|
..S PSBGNODE="^PSB(53.79,"_"""AUID"""_","_DFN_")"
|
|
..F S PSBGNODE=$Q(@PSBGNODE) Q:PSBGNODE="" Q:$QS(PSBGNODE,3)'=DFN D
|
|
...I $QS(PSBGNODE,4)=PSBORD D
|
|
....S PSBBIEN=$QS(PSBGNODE,6)
|
|
....S PSBSTATS=$P(^PSB(53.79,PSBBIEN,0),U,9) D:(PSBSTATS="I")!(PSBSTATS="S") Q
|
|
.....S PSBBUID=$QS(PSBGNODE,5),PSBOR=$$FNDLBLO^PSBVDLU2(PSBPIN,$QS(PSBGNODE,4),PSBBUID),(PSBXOR,PSBLOR)=PSBOR
|
|
.....; G IV bag
|
|
.....; IS ORD is "live"
|
|
.....S PSBNXOR=PSBOR
|
|
.....S PSBSTOP=0 F K ^TMP("PSJ1",$J) D EN^PSJBCMA1(DFN,PSBNXOR,1) S:($P(^TMP("PSJ1",$J,0),U,5)']"")&($P($G(^TMP("PSJ1",$J,4)),U,7)<PSBDT) PSBSTOP=1 Q:PSBNXOR=$P(^TMP("PSJ1",$J,0),U,5) S PSBNXOR=$P(^TMP("PSJ1",$J,0),U,5) Q:PSBNXOR']""
|
|
.....I 'PSBSTOP F PSBXX=1:1 D K ^TMP("PSJ1",$J) S:PSBOR="" PSBCO(PSBXOR)=PSBLOR Q:PSBOR="" ;
|
|
......K ^TMP("PSJ1",$J) D EN^PSJBCMA1(DFN,PSBOR,1)
|
|
......S PSBDX="" F S PSBDX=$O(^TMP("PSJ1",$J,PSBDX)) Q:PSBDX="" I $D(^TMP("PSJ1",$J,PSBDX,1000,PSBBUID)) S PSBLABDT=$P(^TMP("PSJ1",$J,PSBDX,1000,PSBBUID,0),U) Q
|
|
......K ^TMP("PSJ2",$J) D EN^PSJBCMA2(DFN,PSBOR,1) D:$D(^TMP("PSJ2",$J))
|
|
.......S PSBX=0 F S PSBX=$O(^TMP("PSJ2",$J,PSBX)) Q:PSBX="" D:$P(^TMP("PSJ2",$J,PSBX,1),U,3)]""
|
|
........S PSBCHGDT=$P(^TMP("PSJ2",$J,PSBX,1),U),PSBPARAM=$P(^TMP("PSJ2",$J,PSBX,1),U,3)
|
|
........I ($P(^TMP("PSJ2",$J,PSBX,1),U)'<$G(PSBLABDT)) S PSBIVCHG(PSBXOR,PSBCHGDT,PSBPARAM)=" changed to ",PSBIVCHG(PSBXOR,PSBCHGDT,PSBPARAM)=PSBIVCHG(PSBXOR,PSBCHGDT,PSBPARAM)_$$NEWDATA(PSBPARAM)
|
|
......M PSBBAGD(PSBXOR,PSBXX,0)=^TMP("PSJ1",$J,0),PSBBAGD(PSBXOR,PSBXX,4)=^TMP("PSJ1",$J,4),PSBBAGD(PSBXOR,PSBXX,2)=^TMP("PSJ1",$J,2)
|
|
......F PSBX=800,850,900,950,1000 D
|
|
.......I "800900"[PSBX M PSBBAGD(PSBXOR,PSBXX,PSBX,PSBBUID)=^TMP("PSJ1",$J,PSBX,PSBBUID)
|
|
.......I ("850950"[PSBX),'$D(PSBBAGD(PSBXOR,PSBXX,(PSBX-50),PSBBUID)) M PSBBAGD(PSBXOR,PSBXX,PSBX,PSBBUID)=^TMP("PSJ1",$J,PSBX)
|
|
.......S:PSBXX=1 PSBBUIDS(PSBXOR,PSBBUID)=PSBXOR_U_PSBBUID_U_($P(PSBBAGD(PSBXOR,PSBXX,2),U,2))_U_PSBSTATS
|
|
.......D:(PSBXX=1)
|
|
........I (PSBX=800) F PSBXY=0 S PSBXY=$O(PSBBAGD(PSBXOR,1,800,PSBBUID,PSBXY)) Q:PSBXY="" S PSBBUIDS(PSBXOR,PSBBUID,"ADD",PSBXY)="ADD"_U_PSBBAGD(PSBXOR,1,800,PSBBUID,PSBXY)
|
|
........I (PSBX=900) F PSBXY=0 S PSBXY=$O(PSBBAGD(PSBXOR,1,900,PSBBUID,PSBXY)) Q:PSBXY="" S PSBBUIDS(PSBXOR,PSBBUID,"SOL",PSBXY)="SOL"_U_PSBBAGD(PSBXOR,1,900,PSBBUID,PSBXY)
|
|
........I (PSBX=850) F PSBXY=0 S PSBXY=$O(PSBBAGD(PSBXOR,1,850,PSBBUID,PSBXY)) Q:PSBXY="" S PSBBUIDS(PSBXOR,PSBBUID,"ADD",PSBXY)="ADD"_U_PSBBAGD(PSBXOR,1,850,PSBBUID,PSBXY,0)
|
|
........I (PSBX=950) F PSBXY=0 S PSBXY=$O(PSBBAGD(PSBXOR,1,950,PSBBUID,PSBXY)) Q:PSBXY="" S PSBBUIDS(PSBXOR,PSBBUID,"SOL",PSBXY)="SOL"_U_PSBBAGD(PSBXOR,1,950,PSBBUID,PSBXY,0)
|
|
......S PSBLOR=$P(^TMP("PSJ1",$J,0),U,3),PSBOR=$P(^TMP("PSJ1",$J,0),U,5) K ^TMP("PSJ1",$J)
|
|
......I PSBOR["P" S PSBOR=$$PSBNXACT(PSBPIN,PSBOR)
|
|
S (PSBLINES,RESULTS(0))=0
|
|
Q:$G(PSBGNODE)=""
|
|
I $D(PSBBAGD) S PSBXOR="" F S PSBXOR=$O(PSBBAGD(PSBXOR)) Q:PSBXOR="" D
|
|
.S PSBXX=$O(PSBBAGD(PSBXOR,""),-1)
|
|
.I $P(PSBBAGD(PSBXOR,PSBXX,4),U,7)<PSBDT S PSBLINES=0 Q ; "Whole of" order exp 3 dAYS ago proc nxt
|
|
.F PSBXX=1:1:($O(PSBBAGD(PSBXOR,""),-1)-1) S PSBXY=PSBXX+1 D:$D(PSBBAGD(PSBXOR,PSBXY))
|
|
..D CLEAN^PSBVT,PSJ1^PSBVT(PSBPIN,$P(PSBBAGD(PSBXOR,PSBXX,0),U,3))
|
|
..K PSBOTMP
|
|
..I $D(PSBADA) M PSBOTMP("ADD")=PSBADA E S PSBOTMP("ADD")=""
|
|
..I $D(PSBSOLA) M PSBOTMP("SOL")=PSBSOLA E S PSBOTMP("SOL")="" ;solut,vol
|
|
..K PSBADA,PSBSOLA
|
|
..S PSBOTMP("INFUSION RATE")=$G(PSBIFR)
|
|
..S PSBOTMP("MED ROUTE")=$G(PSBMR)
|
|
..S PSBOTMP("REMARKS")=$G(PSBRMRK)
|
|
..S PSBOTMP("OTHER PRINT INFO")=$G(PSBOTXT)
|
|
..S PSBOTMP("PROVIDER")=PSBMD
|
|
..S PSBOTMP("START DATE/TIME")=PSBOST
|
|
..S PSBOTMP("STOP DATE/TIME")=PSBOSP
|
|
..D CLEAN^PSBVT,PSJ1^PSBVT(PSBPIN,$P(PSBBAGD(PSBXOR,PSBXY,0),U,3))
|
|
..D EN^PSJBCMA2(PSBPIN,$P(PSBBAGD(PSBXOR,PSBXY,0),U,3),1) S:$P(^TMP("PSJ2",$J,1,1),U)]"" PSBCHGDT=$P(^TMP("PSJ2",$J,1,1),U)
|
|
..I $D(PSBADA)!($D(PSBOTMP("ADD"))) D CHKADD
|
|
..I $D(PSBSOLA)!($D(PSBOTMP("SOL"))) D CHKSOL
|
|
..I PSBIFR'=PSBOTMP("INFUSION RATE") S:PSBOTMP("INFUSION RATE")]"" PSBIVCHG(PSBXOR,PSBCHGDT,"INFUSION RATE")=" changed to "_PSBIFR
|
|
..I PSBMR'=PSBOTMP("MED ROUTE") S:PSBMR'=PSBOTMP("MED ROUTE")]"" PSBIVCHG(PSBXOR,PSBCHGDT,"MED ROUTE")=" changed to "_PSBMR
|
|
..I PSBRMRK'=PSBOTMP("REMARKS") S:PSBOTMP("REMARKS")]"" PSBIVCHG(PSBXOR,PSBCHGDT,"REMARKS")=" changed to "_PSBRMRK
|
|
..I PSBOTXT'=PSBOTMP("OTHER PRINT INFO") S:PSBOTMP("OTHER PRINT INFO")]"" PSBIVCHG(PSBXOR,PSBCHGDT,"OTHER PRINT INFO")=" changed to "_PSBOTXT
|
|
..I PSBMD'=PSBOTMP("PROVIDER") S:PSBOTMP("PROVIDER")]"" PSBIVCHG(PSBXOR,PSBCHGDT,"PROVIDER")=" changed to "_PSBMDX
|
|
..I $E(PSBOST,1,12)'=$E(PSBOTMP("START DATE/TIME"),1,12) S PSBIVCHG(PSBXOR,PSBCHGDT,"START DATE/TIME")=" changed to "_PSBOSTX
|
|
..I $E(PSBOSP,1,12)'=$E(PSBOTMP("STOP DATE/TIME"),1,12) S PSBIVCHG(PSBXOR,PSBCHGDT,"STOP DATE/TIME")=" changed to "_PSBOSPX
|
|
..D CLEAN^PSBVT
|
|
; Get RESULTS
|
|
D:$D(PSBIVCHG)
|
|
.S PSBXX="" F S PSBXX=$O(PSBIVCHG(PSBXX)) S:PSBLINES>0 PSBLINES=PSBLINES+1,RESULTS(PSBLINES)="END",RESULTS(0)=PSBLINES Q:PSBXX="" D
|
|
..S PSBXY="" F S PSBXY=$O(PSBBUIDS(PSBXX,PSBXY)) Q:PSBXY="" D
|
|
...S PSBLINES=PSBLINES+1,RESULTS(PSBLINES)=PSBBUIDS(PSBXX,PSBXY)_U_PSBCO(PSBXX)
|
|
...S PSBXZ=0 F S PSBXZ=$O(PSBBUIDS(PSBXX,PSBXY,"ADD",PSBXZ)) Q:PSBXZ="" S PSBLINES=PSBLINES+1,RESULTS(PSBLINES)=PSBBUIDS(PSBXX,PSBXY,"ADD",PSBXZ)
|
|
...S PSBXZ=0 F S PSBXZ=$O(PSBBUIDS(PSBXX,PSBXY,"SOL",PSBXZ)) Q:PSBXZ="" S PSBLINES=PSBLINES+1,RESULTS(PSBLINES)=PSBBUIDS(PSBXX,PSBXY,"SOL",PSBXZ)
|
|
..S PSBXY="" F S PSBXY=$O(PSBIVCHG(PSBXX,PSBXY),-1) Q:PSBXY="" D
|
|
...S PSBXZ="" F S PSBXZ=$O(PSBIVCHG(PSBXX,PSBXY,PSBXZ)) Q:PSBXZ="" D
|
|
....I '("ADDITIVE STRENGTH SOLUTION VOLUME "[PSBXZ) S PSBLINES=PSBLINES+1,RESULTS(PSBLINES)="CD"_U_PSBXY_U_PSBXZ_PSBIVCHG(PSBXX,PSBXY,PSBXZ)
|
|
....I "ADDITIVE STRENGTH SOLUTION VOLUME "[PSBXZ S PSBZX="" F S PSBZX=$O(PSBIVCHG(PSBXX,PSBXY,PSBXZ,PSBZX)) Q:PSBZX="" S PSBLINES=PSBLINES+1,RESULTS(PSBLINES)="CD"_U_PSBXY_U_PSBXZ_PSBIVCHG(PSBXX,PSBXY,PSBXZ,PSBZX)
|
|
K PSBIVCHG,PSBLINES,PSBBAGD,PSBAD,PSBSOL
|
|
Q
|
|
CHKADD N X,PSBADDS ; Check addit(s)
|
|
I '$D(PSBADA),'$D(PSBOTMP("ADD")) Q ; no adds
|
|
S X="" F S X=$O(PSBOTMP("ADD",X)) Q:X="" K PSBAD,PSBSTR S PSBAD=$P(PSBOTMP("ADD",X),U,2),PSBSTR=$P(PSBOTMP("ADD",X),U,4),PSBADDS(PSBAD,PSBSTR)=PSBOTMP("ADD",X)
|
|
S X="" F S X=$O(PSBADA(X)) Q:X="" D
|
|
.K PSBAD,PSBSTR S PSBAD=$P(PSBADA(X),U,2),PSBSTR=$P(PSBADA(X),U,4)
|
|
.I $D(PSBADDS(PSBAD,PSBSTR)) K PSBADDS(PSBAD,PSBSTR) Q
|
|
.I '$D(PSBADDS(PSBAD)) S PSBTXT=PSBADA(X),$P(PSBTXT,U,1)="",$P(PSBTXT,U,2)="",PSBIVCHG(PSBXOR,PSBCHGDT,"ADDITIVE",PSBAD)=" added"_$TR(PSBTXT,U," ")
|
|
.E K PSBADDS(PSBAD) S PSBIVCHG(PSBXOR,PSBCHGDT,"STRENGTH ",PSBAD)=$P(PSBADA(X),U,3)_" changed to "_$P(PSBADA(X),U,4)
|
|
S X="" F S X=$O(PSBADDS(X)) Q:X="" I '$D(PSBIVCHG(PSBXOR,PSBCHGDT,"ADDITIVE",X)) S PSBTXT=PSBADDS(X,($O(PSBADDS(X,"")))),$P(PSBTXT,U,1)="",$P(PSBTXT,U,2)="",PSBIVCHG(PSBXOR,PSBOST,"ADDITIVE",X)=" deleted"_$TR(PSBTXT,U," ")
|
|
Q
|
|
CHKSOL N Y,PSBSOLS ; Check solut(s)
|
|
I '$D(PSBSOLA),'$D(PSBOTMP("SOL")) Q ; no sols
|
|
S Y="" F S Y=$O(PSBOTMP("SOL",Y)) Q:Y="" K PSBSOL,PSBVOL S PSBSOL=$P(PSBOTMP("SOL",Y),U,2),PSBVOL=$P(PSBOTMP("SOL",Y),U,4),PSBSOLS(PSBSOL,PSBVOL)=PSBOTMP("SOL",Y)
|
|
S Y="" F S Y=$O(PSBSOLA(Y)) Q:Y="" D
|
|
.K PSBSOL,PSBVOL S PSBSOL=$P(PSBSOLA(Y),U,2),PSBVOL=$P(PSBSOLA(Y),U,4)
|
|
.I $D(PSBSOLS(PSBSOL,PSBVOL)) K PSBSOLS(PSBSOL,PSBVOL) Q
|
|
.I '$D(PSBSOLS(PSBSOL)) S PSBTXT=PSBSOLA(Y),$P(PSBTXT,U,1)="",$P(PSBTXT,U,2)="",PSBIVCHG(PSBXOR,PSBCHGDT,"SOLUTION",PSBSOL)=" added"_$TR(PSBTXT,U," ")
|
|
.E K PSBSOLS(PSBSOL) S PSBIVCHG(PSBXOR,PSBCHGDT,"VOLUME ",PSBSOL)=$P(PSBSOLA(Y),U,3)_" changed to "_$P(PSBSOLA(Y),U,4)
|
|
S Y="" F S Y=$O(PSBSOLS(Y)) Q:Y="" S:'$D(PSBIVCHG(PSBXOR,PSBCHGDT,"SOLUTION",Y)) PSBTXT=PSBSOLS(Y,($O(PSBSOLS(Y,"")))),$P(PSBTXT,U,1)="",$P(PSBTXT,U,2)="",PSBIVCHG(PSBXOR,PSBCHGDT,"SOLUTION",Y)=" deleted"_$TR(PSBTXT,U," ")
|
|
Q
|
|
PSBNXACT(DFN,PORDN) ;
|
|
N PSBDFN,PSBOR S PSBDFN=DFN,PSBOR=PORDN K PSBDID
|
|
S PSBNXACT="" I (PSBDFN="")!(PSBOR="")!(PSBOR'["P") Q PSBNXACT
|
|
F Q:PSBOR="" Q:$D(PSBDID(PSBOR)) D
|
|
.K ^TMP("PSJ1",$J) D EN^PSJBCMA1(PSBDFN,PSBOR,1) S PSBOR=$P(^TMP("PSJ1",$J,0),U,5) K ^TMP("PSJ1",$J)
|
|
.I $G(PSBOR)]"",$G(PSBOR)'["P" S PSBNXACT=PSBOR S PSBOR=""
|
|
.E S:$G(PSBOR)]"" (PSBNXACT,PSBDID($G(PSBOR)))=""
|
|
.K ^TMP("PSJ1",$J)
|
|
I PSBNXACT="" D EN^PSJBCMA1(PSBDFN,PSBLOR,1) I $P(^TMP("PSJ1",$J,4),U,7)<PSBDT K PSBBAGD(PSBXOR),PSBBUIDS(PSBXOR),PSBIVCHG(PSBXOR)
|
|
Q PSBNXACT
|
|
NEWDATA(PSBPARM) ;
|
|
S NEWDATA="" N PSBDX S PSBDX="",PSBDX=$O(PSBIVCHG(PSBXOR,PSBDX),-1)
|
|
F S PSBDX=$O(PSBIVCHG(PSBXOR,PSBDX),-1) Q:PSBDX="" D:$D(PSBIVCHG(PSBXOR,PSBDX,PSBPARM)) Q:PSBDX=""
|
|
.S PSBIVCHG(PSBXOR,PSBDX,PSBPARM)=" changed to "_$G(^TMP("PSJ2",$J,PSBX,2)),PSBDX=""
|
|
I $G(PSBPARM)="INFUSION RATE" Q $P(^TMP("PSJ1",$J,2),U,4)
|
|
I $G(PSBPARM)="MED ROUTE" Q $P(^TMP("PSJ1",$J,1),U,13)
|
|
I $G(PSBPARM)="PROVIDER" Q $P(^TMP("PSJ1",$J,1),U,2)
|
|
I $G(PSBPARM)="REMARKS" Q $G(^TMP("PSJ1",$J,6))
|
|
I $G(PSBPARM)="OTHER PRINT INFO" Q $G(^TMP("PSJ1",$J,3))
|
|
I $G(PSBPARM)="STOP DATE/TIME" Q $P(^TMP("PSJ1",$J,4),U,8)
|
|
I $G(PSBPARM)="START DATE/TIME" Q $P(^TMP("PSJ1",$J,4),U,6)
|
|
Q NEWDATA
|