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