APCHPMH2 ; IHS/CMI/LAB - Patient Wellness Handout ;
;;2.0;IHS PCC SUITE;**7**;MAY 14, 2009
;
;
;
Q
LAB(P,T,LT) ;EP
I '$G(LT) S LT=""
NEW D,V,G,X,J S (D,G)=0 F S D=$O(^AUPNVLAB("AE",P,D)) Q:D'=+D!(G) D
.S X=0 F S X=$O(^AUPNVLAB("AE",P,D,X)) Q:X'=+X!(G) D
..S Y=0 F S Y=$O(^AUPNVLAB("AE",P,D,X,Y)) Q:Y'=+Y!(G) D
...I $D(^ATXLAB(T,21,"B",X)),$P(^AUPNVLAB(Y,0),U,4)]"" S G=Y Q
...Q:'LT
...S J=$P($G(^AUPNVLAB(Y,11)),U,13) Q:J=""
...Q:'$$LOINC(J,LT)
...S G=Y
...Q
..Q
.Q
I 'G S R=$$REF(P,T) Q "||||||"_R
Q $P(^AUPNVLAB(G,0),U,4)_"|||"_$$FMTE^XLFDT($P($P(^AUPNVSIT($P(^AUPNVLAB(G,0),U,3),0),U),"."))_"|||"_$$REF(P,T,$P($P(^AUPNVSIT($P(^AUPNVLAB(G,0),U,3),0),U),"."))_"|||"_G
LOINC(A,B) ;
NEW %
S %=$P($G(^LAB(95.3,A,9999999)),U,2)
I %]"",$D(^ATXAX(B,21,"B",%)) Q 1
S %=$P($G(^LAB(95.3,A,0)),U)_"-"_$P($G(^LAB(95.3,A,0)),U,15)
I $D(^ATXAX(B,21,"B",%)) Q 1
Q ""
;
DATE(D) ;EP - convert to slashed date
I $G(D)="" Q ""
Q $E(D,4,5)_"/"_$E(D,6,7)_"/"_$E(D,2,3)
REF(P,T,D) ;return refusal string after date D for test is tax T
I '$G(P) Q ""
I '$G(T) Q ""
I '$G(D) S D=""
N APCHREF,APCHT,V S APCHT=0 F S APCHT=$O(^ATXLAB(T,21,"B",APCHT)) Q:APCHT'=+APCHT D
.S V=$$REF1(P,60,APCHT,D) I V]"" S APCHREF(9999999-$P(V,U,3))=V
I $D(APCHREF) S %=0,%=$O(APCHREF(%)) I % S V=APCHREF(%) Q V
Q ""
REF1(P,F,I,D,T) ; ;
I '$G(P) Q ""
I '$G(F) Q ""
I '$G(I) Q ""
I $G(D)="" S D=""
I $G(T)="" S T="E"
NEW X,N S X=$O(^AUPNPREF("AA",P,F,I,0))
I 'X Q "" ;none of this item was refused
S N=$O(^AUPNPREF("AA",P,F,I,X,0))
NEW Y S Y=9999999-X
I D]"",Y>D Q $S(T="I":Y,1:$$TYPEREF(N)_"-"_$$DATE(Y))
I T="I" Q Y ;quit on internal form of date
Q $$TYPEREF(N)_"-"_$$DATE(Y)
;
TYPEREF(N) ;
NEW % S %=$P(^AUPNPREF(N,0),U,7)
I %="R"!(%="") Q "Declined"
I %="N" Q "Not Med Ind"
I %="F" Q "No Resp to F/U"
Q ""
;
;
GETLABSX ;get lab tests ordered today
;
S APCHLR=$G(^DPT(APCHSDFN,"LR"))
I $G(APCHLR)]"" S APCHLRO=0,APCHTSTP=0 D
.F S APCHLRO=$O(^LRO(69,DT,1,"AA",APCHLR,APCHLRO)) Q:APCHLRO="" Q:APCHLRO'=+APCHLRO D
..F S APCHTSTP=$O(^LRO(69,DT,1,APCHLRO,2,"B",APCHTSTP)) Q:APCHTSTP'=+APCHTSTP D
...S APCHTCTR=$O(^LRO(69,DT,1,APCHLRO,2,"B",APCHTSTP,0))
...S APCHTEST=$P(^LAB(60,APCHTSTP,0),U)
...S APCHTST(APCHTEST)=""
...Q
;
;
GETLABS ;get todays labs from V Lab File
S APCHSIVD=9999999-DT
I $D(^AUPNVLAB("AE",APCHSDFN,APCHSIVD)) S APCHTSTP=0,APCHVLAB=0 D
.F S APCHTSTP=$O(^AUPNVLAB("AE",APCHSDFN,APCHSIVD,APCHTSTP)) Q:APCHTSTP="" Q:APCHTSTP'=+APCHTSTP D
..S APCHTEST=$P(^LAB(60,APCHTSTP,0),U),APCHTST(APCHTEST)=""
..S APCHVLAB=$O(^AUPNVLAB("AE",APCHSDFN,APCHSIVD,APCHTSTP,APCHVLAB)) Q:APCHVLAB'=+APCHVLAB
..I $D(^AUPNVLAB(APCHVLAB,21)) S APCHCTR=0 F S APCHCTR=$O(^AUPNVLAB(APCHVLAB,21,APCHCTR)) Q:'APCHCTR D
...Q:APCHCTR'=+APCHCTR
...S APCHTST(APCHTEST,APCHCTR)=$P(^AUPNVLAB(APCHVLAB,21,APCHCTR,0),U)
..Q
Q
;
APCHLHD ;
;S X="Lab tests can help measure health and some check to make sure that your" D S(X,1)
;S X="medicines are working right." D S(X)
;
APCHPMH2 ; IHS/CMI/LAB - Patient Wellness Handout ;
+1 ;;2.0;IHS PCC SUITE;**7**;MAY 14, 2009
+2 ;
+3 ;
+4 ;
+5 QUIT
LAB(P,T,LT) ;EP
+1 IF '$GET(LT)
SET LT=""
+2 NEW D,V,G,X,J
SET (D,G)=0
FOR
SET D=$ORDER(^AUPNVLAB("AE",P,D))
IF D'=+D!(G)
QUIT
Begin DoDot:1
+3 SET X=0
FOR
SET X=$ORDER(^AUPNVLAB("AE",P,D,X))
IF X'=+X!(G)
QUIT
Begin DoDot:2
+4 SET Y=0
FOR
SET Y=$ORDER(^AUPNVLAB("AE",P,D,X,Y))
IF Y'=+Y!(G)
QUIT
Begin DoDot:3
+5 IF $DATA(^ATXLAB(T,21,"B",X))
IF $PIECE(^AUPNVLAB(Y,0),U,4)]""
SET G=Y
QUIT
+6 IF 'LT
QUIT
+7 SET J=$PIECE($GET(^AUPNVLAB(Y,11)),U,13)
IF J=""
QUIT
+8 IF '$$LOINC(J,LT)
QUIT
+9 SET G=Y
+10 QUIT
End DoDot:3
+11 QUIT
End DoDot:2
+12 QUIT
End DoDot:1
+13 IF 'G
SET R=$$REF(P,T)
QUIT "||||||"_R
+14 QUIT $PIECE(^AUPNVLAB(G,0),U,4)_"|||"_$$FMTE^XLFDT($PIECE($PIECE(^AUPNVSIT($PIECE(^AUPNVLAB(G,0),U,3),0),U),"."))_"|||"_$$REF(P,T,$PIECE($PIECE(^AUPNVSIT($PIECE(^AUPNVLAB(G,0),U,3),0),U),"."))_"|||"_G
LOINC(A,B) ;
+1 NEW %
+2 SET %=$PIECE($GET(^LAB(95.3,A,9999999)),U,2)
+3 IF %]""
IF $DATA(^ATXAX(B,21,"B",%))
QUIT 1
+4 SET %=$PIECE($GET(^LAB(95.3,A,0)),U)_"-"_$PIECE($GET(^LAB(95.3,A,0)),U,15)
+5 IF $DATA(^ATXAX(B,21,"B",%))
QUIT 1
+6 QUIT ""
+7 ;
DATE(D) ;EP - convert to slashed date
+1 IF $GET(D)=""
QUIT ""
+2 QUIT $EXTRACT(D,4,5)_"/"_$EXTRACT(D,6,7)_"/"_$EXTRACT(D,2,3)
REF(P,T,D) ;return refusal string after date D for test is tax T
+1 IF '$GET(P)
QUIT ""
+2 IF '$GET(T)
QUIT ""
+3 IF '$GET(D)
SET D=""
+4 NEW APCHREF,APCHT,V
SET APCHT=0
FOR
SET APCHT=$ORDER(^ATXLAB(T,21,"B",APCHT))
IF APCHT'=+APCHT
QUIT
Begin DoDot:1
+5 SET V=$$REF1(P,60,APCHT,D)
IF V]""
SET APCHREF(9999999-$PIECE(V,U,3))=V
End DoDot:1
+6 IF $DATA(APCHREF)
SET %=0
SET %=$ORDER(APCHREF(%))
IF %
SET V=APCHREF(%)
QUIT V
+7 QUIT ""
REF1(P,F,I,D,T) ; ;
+1 IF '$GET(P)
QUIT ""
+2 IF '$GET(F)
QUIT ""
+3 IF '$GET(I)
QUIT ""
+4 IF $GET(D)=""
SET D=""
+5 IF $GET(T)=""
SET T="E"
+6 NEW X,N
SET X=$ORDER(^AUPNPREF("AA",P,F,I,0))
+7 ;none of this item was refused
IF 'X
QUIT ""
+8 SET N=$ORDER(^AUPNPREF("AA",P,F,I,X,0))
+9 NEW Y
SET Y=9999999-X
+10 IF D]""
IF Y>D
QUIT $SELECT(T="I":Y,1:$$TYPEREF(N)_"-"_$$DATE(Y))
+11 ;quit on internal form of date
IF T="I"
QUIT Y
+12 QUIT $$TYPEREF(N)_"-"_$$DATE(Y)
+13 ;
TYPEREF(N) ;
+1 NEW %
SET %=$PIECE(^AUPNPREF(N,0),U,7)
+2 IF %="R"!(%="")
QUIT "Declined"
+3 IF %="N"
QUIT "Not Med Ind"
+4 IF %="F"
QUIT "No Resp to F/U"
+5 QUIT ""
+6 ;
+7 ;
GETLABSX ;get lab tests ordered today
+1 ;
+2 SET APCHLR=$GET(^DPT(APCHSDFN,"LR"))
+3 IF $GET(APCHLR)]""
SET APCHLRO=0
SET APCHTSTP=0
Begin DoDot:1
+4 FOR
SET APCHLRO=$ORDER(^LRO(69,DT,1,"AA",APCHLR,APCHLRO))
IF APCHLRO=""
QUIT
IF APCHLRO'=+APCHLRO
QUIT
Begin DoDot:2
+5 FOR
SET APCHTSTP=$ORDER(^LRO(69,DT,1,APCHLRO,2,"B",APCHTSTP))
IF APCHTSTP'=+APCHTSTP
QUIT
Begin DoDot:3
+6 SET APCHTCTR=$ORDER(^LRO(69,DT,1,APCHLRO,2,"B",APCHTSTP,0))
+7 SET APCHTEST=$PIECE(^LAB(60,APCHTSTP,0),U)
+8 SET APCHTST(APCHTEST)=""
+9 QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+10 ;
+11 ;
GETLABS ;get todays labs from V Lab File
+1 SET APCHSIVD=9999999-DT
+2 IF $DATA(^AUPNVLAB("AE",APCHSDFN,APCHSIVD))
SET APCHTSTP=0
SET APCHVLAB=0
Begin DoDot:1
+3 FOR
SET APCHTSTP=$ORDER(^AUPNVLAB("AE",APCHSDFN,APCHSIVD,APCHTSTP))
IF APCHTSTP=""
QUIT
IF APCHTSTP'=+APCHTSTP
QUIT
Begin DoDot:2
+4 SET APCHTEST=$PIECE(^LAB(60,APCHTSTP,0),U)
SET APCHTST(APCHTEST)=""
+5 SET APCHVLAB=$ORDER(^AUPNVLAB("AE",APCHSDFN,APCHSIVD,APCHTSTP,APCHVLAB))
IF APCHVLAB'=+APCHVLAB
QUIT
+6 IF $DATA(^AUPNVLAB(APCHVLAB,21))
SET APCHCTR=0
FOR
SET APCHCTR=$ORDER(^AUPNVLAB(APCHVLAB,21,APCHCTR))
IF 'APCHCTR
QUIT
Begin DoDot:3
+7 IF APCHCTR'=+APCHCTR
QUIT
+8 SET APCHTST(APCHTEST,APCHCTR)=$PIECE(^AUPNVLAB(APCHVLAB,21,APCHCTR,0),U)
End DoDot:3
+9 QUIT
End DoDot:2
End DoDot:1
+10 QUIT
+11 ;
APCHLHD ;
+1 ;S X="Lab tests can help measure health and some check to make sure that your" D S(X,1)
+2 ;S X="medicines are working right." D S(X)
+3 ;
