BTIULO15 ; IHS/MSC/MGH - STILL MORE OBJECTS FOR ASTHMA ;14-Sep-2011 11:49;DU
;;1.0;TEXT INTEGRATION UTILITIES;**1009**;NOV 04, 2004;Build 22
AREL(DFN,TARGET) ;Active reliever meds
K @TARGET
W !,"Take your long-term control medication every day.",!
K BTIUHL,BTIUREL
D LAST1YRR(DFN)
K BTIUHL
M BTIUHL=BTIUREL
D DISPMEDS
Q "~@"_$NA(@TARGET)
ACON(DFN,TARGET) ;Active controller meds
K @TARGET
K BTIUHL,BTIUCONT
D LAST1YRC(DFN)
K BTIUHL
M BTIUHL=BTIUCONT
D DISPMEDS
Q "~@"_$NA(@TARGET)
;
PHARM(L,I) ;
NEW %
S %=$O(^PS(59,"C",L,0))
I '%,I="N" Q $P(^DIC(4,L,0),U)
I '%,I="P" Q $$VAL^XBDIQ1(9999999.06,L,.13)
I I="N" Q $P(^PS(59,%,0),U)
I I="P" Q $P(^PS(59,%,0),U,4)
Q ""
;
DISPMEDS ;EP
N D,E,N,X,CNT,BIUMED,BTIUREF,BTIUQTY,BTIUD,BTIUDC,BTIUDYS,BTIUMFX,BTIUCRN,BTIUSIG
N BTIUDTM,BTIUEXP,BTUYSSGY,BTIUORTS,BTIUMED,BTIURX,BTIUSSGY
I '$O(BTIUHL(0)) S @TARGET@(1,0)="None documented" Q
S CNT=0
S D=0 F S D=$O(BTIUHL(D)) Q:D'=+D D
.S E=0 F S E=$O(BTIUHL(D,E)) Q:E'=+E S N=^AUPNVMED(E,0) D
..S BTIUD=$$FMTE^XLFDT($P(^AUPNVSIT($P(N,U,3),0),U),"5D")
..S BTIUDC=$P(N,U,8),BTIUDYS=$P(N,U,7),BTIUMFX=$S($P(N,U,4)="":+N,1:$P(N,U,4)) S:BTIUDYS="" BTIUDYS=30 S BTIURX=$S($D(^PSRX("APCC",E)):$O(^(E,0)),1:0)
..S BTIUCRN=$S(+BTIURX:$D(^PS(55,DFN,"P","CP",BTIURX)),1:0)
..S BTIUQTY=$P(N,U,6),BTIUSIG=$P(N,U,5)
..S BTIUDTM=$P($P(^AUPNVSIT($P(N,U,3),0),U),"."),BTIUEXP=""
..S X=$$FMDIFF^XLFDT(DT,BTIUDTM)
..I X>BTIUDYS S Y=$$FMADD^XLFDT(BTIUDTM,BTIUDYS) S BTIUEXP="-- Ran out "_$$FMTE^XLFDT(Y,"2D")
..S BTIUMED=$S($P(N,U,4)="":$P(^PSDRUG(BTIUMFX,0),U),1:$P(N,U,4))
..I BTIUDC S Y=$$FMTE^XLFDT(BTIUDC) S BTIUEXP="-- D/C "_Y
..S BTIUORTS=$G(^AUPNVMED(E,11))
..I BTIUORTS["RETURNED TO STOCK",BTIUDC S BTIUEXP="--RTS "_Y
..D SIG S BTIUSIG=BTIUSSGY
..D REF I BTIUREF S BTIUSIG=BTIUSIG_" "_BTIUREF_$S(BTIUREF=1:" refill",1:" refills")_" left."
..S X=BTIUD,$E(X,13)=BTIUMED_" #"_BTIUQTY_" ("_BTIUDYS_" days) "_BTIUEXP
..S CNT=CNT+1
..S @TARGET@(CNT,0)=X
..S X="",$E(X,14)=$E(BTIUSIG,1,65)
..S CNT=CNT+1
..S @TARGET@(CNT,0)=X
..I $L(BTIUSIG)>65 D
...S X="",$E(X,14)=$E(BTIUSIG,66,999)
...S CNT=CNT+1
...S @TARGET@(CNT,0)=X
..Q
.Q
Q
;
SIG ;CONSTRUCT THE FULL TEXT FROM THE ENCODED SIG
N BTIUSP
S BTIUSSGY="" F BTIUSP=1:1:$L(BTIUSIG," ") S X=$P(BTIUSIG," ",BTIUSP) I X]"" D
. S Y=$O(^PS(51,"B",X,0)) I Y>0 S X=$P(^PS(51,Y,0),"^",2) I $D(^(9)) S Y=$P(BTIUSIG," ",BTIUSP-1),Y=$E(Y,$L(Y)) S:Y>1 X=$P(^(9),"^",1)
. S BTIUSSGY=BTIUSSGY_X_" "
Q
;
REF ;DETERMINE THE NUMBER OF REFILLS REMAINING
N BTIURFL
I 'BTIURX S BTIUREF=0 Q
S BTIURFL=$P(^PSRX(BTIURX,0),U,9) S BTIUREF=0 F S BTIUREF=$O(^PSRX(BTIURX,1,BTIUREF)) Q:'BTIUREF S BTIURFL=BTIURFL-1
S BTIUREF=BTIURFL
Q
;
LAST1YRR(DFN) ;EP
NEW T,E,D,Y,M,G,C,N
N BTIURXN,BTIUSTAT
S BTIUREL=0
S T(1)=$O(^ATXAX("B","BAT ASTHMA SHRT ACT RELV MEDS",0))
S T(2)=$O(^ATXAX("B","BAT ASTHMA SHRT ACT RELV NDC",0))
S T(3)=$O(^ATXAX("B","BAT ASTHMA SHRT ACT INHLR MEDS",0))
S T(4)=$O(^ATXAX("B","BAT ASTHMA SHRT ACT INHLR NDC",0))
S T(5)=$O(^ATXAX("B","BGP RA GLUCOCORTIOCOIDS MEDS",0))
S T(6)=$O(^ATXAX("B","BGP RA GLUCOCORTIOCOIDS CLASS",0))
S E=9999999-$$FMADD^XLFDT(DT,-183)
S D=0 F S D=$O(^AUPNVMED("AA",DFN,D)) Q:D'=+D!(D>E) D
.S M=0 F S M=$O(^AUPNVMED("AA",DFN,D,M)) Q:M'=+M D
..Q:'$D(^AUPNVMED(M,0))
..S Y=$P(^AUPNVMED(M,0),U)
..Q:'Y
..;is it active?
..I $P(^AUPNVMED(M,0),U,8)]"",$P(^AUPNVMED(M,0),U,8)'>DT Q
..S BTIURXN=$O(^PSRX("APCC",M,0))
..S G=1 I BTIURXN D
...S BTIUSTAT=$P($G(^PSRX(BTIURXN,"STA")),U,1)
...I BTIUSTAT'=0 S G=0
..I 'G Q
..I T(1),$D(^ATXAX(T(1),21,"B",Y)) D SR Q
..I T(3),$D(^ATXAX(T(3),21,"B",Y)) D SR Q
..I T(5),$D(^ATXAX(T(5),21,"B",Y)) D SR Q
..S N=$P($G(^PSDRUG(Y,2)),U,4)
..Q:N=""
..I N]"",T(2),$D(^ATXAX(T(2),21,"B",N)) D SR Q
..I N]"",T(4),$D(^ATXAX(T(4),21,"B",N)) D SR Q
..S C=$P(^PSDRUG(Y,0),U,2)
..I C,T(6),$D(^ATXAX(T(6),21,"B",C)) D SR Q
.Q
Q
SR ;
S BTIUREL(D,M)="",BTIUREL=BTIUREL+1
Q
;
LAST1YRC(DFN) ;EP
NEW T,E,D,Y,M,G,C,N
N BTIURXN,BTIUSTAT
S BTIUCONT=0
S T(1)=$O(^ATXAX("B","BAT ASTHMA CONTROLLER MEDS",0))
S T(2)=$O(^ATXAX("B","BAT ASTHMA CONTROLLER NDC",0))
S T(3)=$O(^ATXAX("B","BAT ASTHMA INHALED STEROIDS",0))
S T(4)=$O(^ATXAX("B","BAT ASTHMA INHLD STEROIDS NDC",0))
S T(5)=$O(^ATXAX("B","BAT ASTHMA LEUKOTRIENE MEDS",0))
S T(6)=$O(^ATXAX("B","BAT ASTHMA LEUKOTRIENE NDC",0))
S E=9999999-$$FMADD^XLFDT(DT,-183)
S D=0 F S D=$O(^AUPNVMED("AA",DFN,D)) Q:D'=+D!(D>E) D
.S M=0 F S M=$O(^AUPNVMED("AA",DFN,D,M)) Q:M'=+M D
..Q:'$D(^AUPNVMED(M,0))
..S Y=$P(^AUPNVMED(M,0),U)
..Q:'Y
..;is it active?
..I $P(^AUPNVMED(M,0),U,8)]"",$P(^AUPNVMED(M,0),U,8)'>DT Q
..S BTIURXN=$O(^PSRX("APCC",M,0))
..S G=1 I BTIURXN D
...S BTIUSTAT=$P($G(^PSRX(BTIURXN,"STA")),U,1)
...I BTIUSTAT'=0 S G=0
..I 'G Q
..I T(1),$D(^ATXAX(T(1),21,"B",Y)) D SC Q
..I T(3),$D(^ATXAX(T(3),21,"B",Y)) D SC Q
..I T(5),$D(^ATXAX(T(5),21,"B",Y)) D SC Q
..S N=$P($G(^PSDRUG(Y,2)),U,4)
..Q:N=""
..I T(2),$D(^ATXAX(T(2),21,"B",N)) D SC Q
..I T(4),$D(^ATXAX(T(4),21,"B",N)) D SC Q
..I T(6),$D(^ATXAX(T(6),21,"B",N)) D SC Q
.Q
Q
SC ;
S BTIUCONT(D,M)="",BTIUCONT=BTIUCONT+1
Q
;
BTIULO15 ; IHS/MSC/MGH - STILL MORE OBJECTS FOR ASTHMA ;14-Sep-2011 11:49;DU
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**1009**;NOV 04, 2004;Build 22
AREL(DFN,TARGET) ;Active reliever meds
+1 KILL @TARGET
+2 WRITE !,"Take your long-term control medication every day.",!
+3 KILL BTIUHL,BTIUREL
+4 DO LAST1YRR(DFN)
+5 KILL BTIUHL
+6 MERGE BTIUHL=BTIUREL
+7 DO DISPMEDS
+8 QUIT "~@"_$NAME(@TARGET)
ACON(DFN,TARGET) ;Active controller meds
+1 KILL @TARGET
+2 KILL BTIUHL,BTIUCONT
+3 DO LAST1YRC(DFN)
+4 KILL BTIUHL
+5 MERGE BTIUHL=BTIUCONT
+6 DO DISPMEDS
+7 QUIT "~@"_$NAME(@TARGET)
+8 ;
PHARM(L,I) ;
+1 NEW %
+2 SET %=$ORDER(^PS(59,"C",L,0))
+3 IF '%
IF I="N"
QUIT $PIECE(^DIC(4,L,0),U)
+4 IF '%
IF I="P"
QUIT $$VAL^XBDIQ1(9999999.06,L,.13)
+5 IF I="N"
QUIT $PIECE(^PS(59,%,0),U)
+6 IF I="P"
QUIT $PIECE(^PS(59,%,0),U,4)
+7 QUIT ""
+8 ;
DISPMEDS ;EP
+1 NEW D,E,N,X,CNT,BIUMED,BTIUREF,BTIUQTY,BTIUD,BTIUDC,BTIUDYS,BTIUMFX,BTIUCRN,BTIUSIG
+2 NEW BTIUDTM,BTIUEXP,BTUYSSGY,BTIUORTS,BTIUMED,BTIURX,BTIUSSGY
+3 IF '$ORDER(BTIUHL(0))
SET @TARGET@(1,0)="None documented"
QUIT
+4 SET CNT=0
+5 SET D=0
FOR
SET D=$ORDER(BTIUHL(D))
IF D'=+D
QUIT
Begin DoDot:1
+6 SET E=0
FOR
SET E=$ORDER(BTIUHL(D,E))
IF E'=+E
QUIT
SET N=^AUPNVMED(E,0)
Begin DoDot:2
+7 SET BTIUD=$$FMTE^XLFDT($PIECE(^AUPNVSIT($PIECE(N,U,3),0),U),"5D")
+8 SET BTIUDC=$PIECE(N,U,8)
SET BTIUDYS=$PIECE(N,U,7)
SET BTIUMFX=$SELECT($PIECE(N,U,4)="":+N,1:$PIECE(N,U,4))
IF BTIUDYS=""
SET BTIUDYS=30
SET BTIURX=$SELECT($DATA(^PSRX("APCC",E)):$ORDER(^(E,0)),1:0)
+9 SET BTIUCRN=$SELECT(+BTIURX:$DATA(^PS(55,DFN,"P","CP",BTIURX)),1:0)
+10 SET BTIUQTY=$PIECE(N,U,6)
SET BTIUSIG=$PIECE(N,U,5)
+11 SET BTIUDTM=$PIECE($PIECE(^AUPNVSIT($PIECE(N,U,3),0),U),".")
SET BTIUEXP=""
+12 SET X=$$FMDIFF^XLFDT(DT,BTIUDTM)
+13 IF X>BTIUDYS
SET Y=$$FMADD^XLFDT(BTIUDTM,BTIUDYS)
SET BTIUEXP="-- Ran out "_$$FMTE^XLFDT(Y,"2D")
+14 SET BTIUMED=$SELECT($PIECE(N,U,4)="":$PIECE(^PSDRUG(BTIUMFX,0),U),1:$PIECE(N,U,4))
+15 IF BTIUDC
SET Y=$$FMTE^XLFDT(BTIUDC)
SET BTIUEXP="-- D/C "_Y
+16 SET BTIUORTS=$GET(^AUPNVMED(E,11))
+17 IF BTIUORTS["RETURNED TO STOCK"
IF BTIUDC
SET BTIUEXP="--RTS "_Y
+18 DO SIG
SET BTIUSIG=BTIUSSGY
+19 DO REF
IF BTIUREF
SET BTIUSIG=BTIUSIG_" "_BTIUREF_$SELECT(BTIUREF=1:" refill",1:" refills")_" left."
+20 SET X=BTIUD
SET $EXTRACT(X,13)=BTIUMED_" #"_BTIUQTY_" ("_BTIUDYS_" days) "_BTIUEXP
+21 SET CNT=CNT+1
+22 SET @TARGET@(CNT,0)=X
+23 SET X=""
SET $EXTRACT(X,14)=$EXTRACT(BTIUSIG,1,65)
+24 SET CNT=CNT+1
+25 SET @TARGET@(CNT,0)=X
+26 IF $LENGTH(BTIUSIG)>65
Begin DoDot:3
+27 SET X=""
SET $EXTRACT(X,14)=$EXTRACT(BTIUSIG,66,999)
+28 SET CNT=CNT+1
+29 SET @TARGET@(CNT,0)=X
End DoDot:3
+30 QUIT
End DoDot:2
+31 QUIT
End DoDot:1
+32 QUIT
+33 ;
SIG ;CONSTRUCT THE FULL TEXT FROM THE ENCODED SIG
+1 NEW BTIUSP
+2 SET BTIUSSGY=""
FOR BTIUSP=1:1:$LENGTH(BTIUSIG," ")
SET X=$PIECE(BTIUSIG," ",BTIUSP)
IF X]""
Begin DoDot:1
+3 SET Y=$ORDER(^PS(51,"B",X,0))
IF Y>0
SET X=$PIECE(^PS(51,Y,0),"^",2)
IF $DATA(^(9))
SET Y=$PIECE(BTIUSIG," ",BTIUSP-1)
SET Y=$EXTRACT(Y,$LENGTH(Y))
IF Y>1
SET X=$PIECE(^(9),"^",1)
+4 SET BTIUSSGY=BTIUSSGY_X_" "
End DoDot:1
+5 QUIT
+6 ;
REF ;DETERMINE THE NUMBER OF REFILLS REMAINING
+1 NEW BTIURFL
+2 IF 'BTIURX
SET BTIUREF=0
QUIT
+3 SET BTIURFL=$PIECE(^PSRX(BTIURX,0),U,9)
SET BTIUREF=0
FOR
SET BTIUREF=$ORDER(^PSRX(BTIURX,1,BTIUREF))
IF 'BTIUREF
QUIT
SET BTIURFL=BTIURFL-1
+4 SET BTIUREF=BTIURFL
+5 QUIT
+6 ;
LAST1YRR(DFN) ;EP
+1 NEW T,E,D,Y,M,G,C,N
+2 NEW BTIURXN,BTIUSTAT
+3 SET BTIUREL=0
+4 SET T(1)=$ORDER(^ATXAX("B","BAT ASTHMA SHRT ACT RELV MEDS",0))
+5 SET T(2)=$ORDER(^ATXAX("B","BAT ASTHMA SHRT ACT RELV NDC",0))
+6 SET T(3)=$ORDER(^ATXAX("B","BAT ASTHMA SHRT ACT INHLR MEDS",0))
+7 SET T(4)=$ORDER(^ATXAX("B","BAT ASTHMA SHRT ACT INHLR NDC",0))
+8 SET T(5)=$ORDER(^ATXAX("B","BGP RA GLUCOCORTIOCOIDS MEDS",0))
+9 SET T(6)=$ORDER(^ATXAX("B","BGP RA GLUCOCORTIOCOIDS CLASS",0))
+10 SET E=9999999-$$FMADD^XLFDT(DT,-183)
+11 SET D=0
FOR
SET D=$ORDER(^AUPNVMED("AA",DFN,D))
IF D'=+D!(D>E)
QUIT
Begin DoDot:1
+12 SET M=0
FOR
SET M=$ORDER(^AUPNVMED("AA",DFN,D,M))
IF M'=+M
QUIT
Begin DoDot:2
+13 IF '$DATA(^AUPNVMED(M,0))
QUIT
+14 SET Y=$PIECE(^AUPNVMED(M,0),U)
+15 IF 'Y
QUIT
+16 ;is it active?
+17 IF $PIECE(^AUPNVMED(M,0),U,8)]""
IF $PIECE(^AUPNVMED(M,0),U,8)'>DT
QUIT
+18 SET BTIURXN=$ORDER(^PSRX("APCC",M,0))
+19 SET G=1
IF BTIURXN
Begin DoDot:3
+20 SET BTIUSTAT=$PIECE($GET(^PSRX(BTIURXN,"STA")),U,1)
+21 IF BTIUSTAT'=0
SET G=0
End DoDot:3
+22 IF 'G
QUIT
+23 IF T(1)
IF $DATA(^ATXAX(T(1),21,"B",Y))
DO SR
QUIT
+24 IF T(3)
IF $DATA(^ATXAX(T(3),21,"B",Y))
DO SR
QUIT
+25 IF T(5)
IF $DATA(^ATXAX(T(5),21,"B",Y))
DO SR
QUIT
+26 SET N=$PIECE($GET(^PSDRUG(Y,2)),U,4)
+27 IF N=""
QUIT
+28 IF N]""
IF T(2)
IF $DATA(^ATXAX(T(2),21,"B",N))
DO SR
QUIT
+29 IF N]""
IF T(4)
IF $DATA(^ATXAX(T(4),21,"B",N))
DO SR
QUIT
+30 SET C=$PIECE(^PSDRUG(Y,0),U,2)
+31 IF C
IF T(6)
IF $DATA(^ATXAX(T(6),21,"B",C))
DO SR
QUIT
End DoDot:2
+32 QUIT
End DoDot:1
+33 QUIT
SR ;
+1 SET BTIUREL(D,M)=""
SET BTIUREL=BTIUREL+1
+2 QUIT
+3 ;
LAST1YRC(DFN) ;EP
+1 NEW T,E,D,Y,M,G,C,N
+2 NEW BTIURXN,BTIUSTAT
+3 SET BTIUCONT=0
+4 SET T(1)=$ORDER(^ATXAX("B","BAT ASTHMA CONTROLLER MEDS",0))
+5 SET T(2)=$ORDER(^ATXAX("B","BAT ASTHMA CONTROLLER NDC",0))
+6 SET T(3)=$ORDER(^ATXAX("B","BAT ASTHMA INHALED STEROIDS",0))
+7 SET T(4)=$ORDER(^ATXAX("B","BAT ASTHMA INHLD STEROIDS NDC",0))
+8 SET T(5)=$ORDER(^ATXAX("B","BAT ASTHMA LEUKOTRIENE MEDS",0))
+9 SET T(6)=$ORDER(^ATXAX("B","BAT ASTHMA LEUKOTRIENE NDC",0))
+10 SET E=9999999-$$FMADD^XLFDT(DT,-183)
+11 SET D=0
FOR
SET D=$ORDER(^AUPNVMED("AA",DFN,D))
IF D'=+D!(D>E)
QUIT
Begin DoDot:1
+12 SET M=0
FOR
SET M=$ORDER(^AUPNVMED("AA",DFN,D,M))
IF M'=+M
QUIT
Begin DoDot:2
+13 IF '$DATA(^AUPNVMED(M,0))
QUIT
+14 SET Y=$PIECE(^AUPNVMED(M,0),U)
+15 IF 'Y
QUIT
+16 ;is it active?
+17 IF $PIECE(^AUPNVMED(M,0),U,8)]""
IF $PIECE(^AUPNVMED(M,0),U,8)'>DT
QUIT
+18 SET BTIURXN=$ORDER(^PSRX("APCC",M,0))
+19 SET G=1
IF BTIURXN
Begin DoDot:3
+20 SET BTIUSTAT=$PIECE($GET(^PSRX(BTIURXN,"STA")),U,1)
+21 IF BTIUSTAT'=0
SET G=0
End DoDot:3
+22 IF 'G
QUIT
+23 IF T(1)
IF $DATA(^ATXAX(T(1),21,"B",Y))
DO SC
QUIT
+24 IF T(3)
IF $DATA(^ATXAX(T(3),21,"B",Y))
DO SC
QUIT
+25 IF T(5)
IF $DATA(^ATXAX(T(5),21,"B",Y))
DO SC
QUIT
+26 SET N=$PIECE($GET(^PSDRUG(Y,2)),U,4)
+27 IF N=""
QUIT
+28 IF T(2)
IF $DATA(^ATXAX(T(2),21,"B",N))
DO SC
QUIT
+29 IF T(4)
IF $DATA(^ATXAX(T(4),21,"B",N))
DO SC
QUIT
+30 IF T(6)
IF $DATA(^ATXAX(T(6),21,"B",N))
DO SC
QUIT
End DoDot:2
+31 QUIT
End DoDot:1
+32 QUIT
SC ;
+1 SET BTIUCONT(D,M)=""
SET BTIUCONT=BTIUCONT+1
+2 QUIT
+3 ;
