APCLAPI2 ; IHS/CMI/LAB - visit data ;
;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
;IHS/TUCSON/LAB - added G parameter to provider call
;
;
;BJPC v1.0 patch 1
;
LASTFRA(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last FALL RISK ASSESSMENT
; Return the last recorded FALL RISK ASSESSMENT:
; - V Exam - 37 Fall Risk Exam
; - Diagnosis - V POV V15.88 OR BGP ABNORMAL GAIT OR MOBILITY taxonomy
; - V POV: Ecode in BGP FALL RELATED E-CODES taxonomy
;
; Input:
; APCLPDFN - Patient DFN
; APCLBD - beginning date to begin search for value - if blank, default is DOB
; APCLED - ending date of search - if blank, default is DT
; APCLFORM - APCLFORM returned: D - return date only - example 3070801
; A - return value:
; date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
; Default if blank is D
; Output:
; If APCLFORM is blank or APCLFORM is D returns internal fileman date if one found otherwise returns null
; If APCLFORM is A returns the string:
; date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
;
I $G(APCLPDFN)="" Q ""
I $G(APCLBD)="" S APCLBD=$$DOB^AUPNPAT(APCLPDFN)
I $G(APCLED)="" S APCLED=DT
I $G(APCLFORM)="" S APCLFORM="D"
NEW APCLLAST,APCLVAL,APCLX,R,X,Y,V,E,T,G,APCLY,APCLF,APCLZ
S APCLLAST=""
S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,37,"EXAM",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
D E
S APCLVAL=$$LASTDXT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"BGP HISTORY OF FALL DXS","A")
D E
S APCLVAL=$$LASTDXT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"BGP ABNORMAL GAIT OR MOBILITY","A")
D E
S Y="APCLZ("
K APCLZ
S X=APCLPDFN_"^ALL DX;DURING "_$$FMADD^XLFDT(APCLED,-365)_"-"_DT S E=$$START1^APCLDF(X,Y)
S G=""
S T=$O(^ATXAX("B","BGP FALL RELATED E-CODES",0))
S X=0 F S X=$O(APCLZ(X)) Q:X'=+X D
.S G="" S Y=+$P(APCLZ(X),U,4),D=$P(^AUPNVPOV(Y,0),U)
.I $P(^AUPNVPOV(Y,0),U,9)="",$P(^AUPNVPOV(Y,0),U,18)="",$P(^AUPNVPOV(Y,0),U,19)="" Q
.S E=$P(^AUPNVPOV(Y,0),U,9) I E,$$ICD^ATXAPI(E,T,9) D VPVE Q
.S E=$P(^AUPNVPOV(Y,0),U,18) I E,$$ICD^ATXAPI(E,T,9) D VPVE Q
.S E=$P(^AUPNVPOV(Y,0),U,19) I E,$$ICD^ATXAPI(E,T,9) D VPVE Q
I APCLFORM="D" Q $P(APCLLAST,U)
Q APCLLAST
;
VPVE ;EP
S APCLLAST=$$VD^APCLV($P(^AUPNVPOV(Y,0),U,3))_"^CAUSE CODE: "_$P($$ICDDX^ICDEX(E),U,2)_"^"_$$VAL^XBDIQ1(9000010.07,Y,.04)_"^"_$P(^AUPNVPOV(Y,0),U,3)_"^9000010.07^"_Y
Q
;
E ;
I $P(APCLVAL,U,1)>$P(APCLLAST,U,1) S APCLLAST=APCLVAL
Q
;
LASTHC(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last head circumference
; Return the last recorded HEAD CIRCUMFERENCE:
; - V Measurment HC
;
; Input:
; APCLPDFN - Patient DFN
; APCLBD - beginning date to begin search for value - if blank, default is DOB
; APCLED - ending date of search - if blank, default is DT
; APCLFORM - APCLFORM returned: D - return date only - example 3070801
; A - return value:
; date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
; Default if blank is D
; Output:
; If APCLFORM is blank or APCLFORM is D returns internal fileman date if one found otherwise returns null
; If APCLFORM is A returns the string:
; date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
;
I $G(APCLPDFN)="" Q ""
I $G(APCLBD)="" S APCLBD=$$DOB^AUPNPAT(APCLPDFN)
I $G(APCLED)="" S APCLED=DT
I $G(APCLFORM)="" S APCLFORM="D"
NEW APCLLAST,APCLVAL,APCLX,R,X,Y,V,E,T,G,APCLY,APCLF
S APCLLAST=""
S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"HC","MEASUREMENT",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
D E
I APCLFORM="D" Q $P(APCLLAST,U)
Q APCLLAST
;
LASTDENT(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last dental exam
; Return the last recorded dental exam:
; - V Dental ADA code 0000 or 0190
; - V Exam 30 - Dental Exam
; - CHS visit with any ADA code
;
; Input:
; APCLPDFN - Patient DFN
; APCLBD - beginning date to begin search for value - if blank, default is DOB
; APCLED - ending date of search - if blank, default is DT
; APCLFORM - APCLFORM returned: D - return date only - example 3070801
; A - return value:
; date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
; Default if blank is D
; Output:
; If APCLFORM is blank or APCLFORM is D returns internal fileman date if one found otherwise returns null
; If APCLFORM is A returns the string:
; date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
;
I $G(APCLPDFN)="" Q ""
I $G(APCLBD)="" S APCLBD=$$DOB^AUPNPAT(APCLPDFN)
I $G(APCLED)="" S APCLED=DT
I $G(APCLFORM)="" S APCLFORM="D"
NEW APCLLAST,APCLVAL,APCLX,R,X,Y,V,E,T,G,APCLY,APCLF,APCLZ
S APCLLAST=""
S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"0000","ADA",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
D E
S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"0190","ADA",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
D E
S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,30,"EXAM",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
D E
;now check CHS visits for any ADA
K APCLY
S X=APCLPDFN_"^ALL ADA;DURING "_$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD)_"-"_APCLED S E=$$START1^APCLDF(X,"APCLZ(")
S X=0 F S X=$O(APCLZ(X)) Q:X'=+X D
.S V=$P(APCLZ(X),U,4)
.Q:$P($G(^AUPNVSIT(V,0)),U,3)'="C"
.S APCLVAL=$P(APCLZ(X),U)_"^ADA: "_$P(APCLZ(X),U,2)_"^^"_$P(APCLZ(X),U,5)_"^9000010.05^"_+$P(APCLZ(X),U,4)
.D E
I APCLFORM="D" Q $P(APCLLAST,U)
Q APCLLAST
;
LASTDEYE(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last diabetic eye exam
; Return the last recorded DIABETIC EYE exam:
; - V Exam Diabetic Eye Exam
; - V CPT 92250, 92012, 92014, 92002, 2022F, 2024F, 2026F, S3000
;
; Input:
; APCLPDFN - Patient DFN
; APCLBD - beginning date to begin search for value - if blank, default is DOB
; APCLED - ending date of search - if blank, default is DT
; APCLFORM - APCLFORM returned: D - return date only - example 3070801
; A - return value:
; date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
; Default if blank is D
; Output:
; If APCLFORM is blank or APCLFORM is D returns internal fileman date if one found otherwise returns null
; If APCLFORM is A returns the string:
; date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
;
I $G(APCLPDFN)="" Q ""
I $G(APCLBD)="" S APCLBD=$$DOB^AUPNPAT(APCLPDFN)
I $G(APCLED)="" S APCLED=DT
I $G(APCLFORM)="" S APCLFORM="D"
NEW APCLLAST,APCLVAL,APCLX,R,X,Y,V,E,T,G,APCLY,APCLF
S APCLLAST=""
S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"03","EXAM",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
D E
S APCLVAL=$$LASTCPTT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"APCH DIABETIC EYE EXAM CPTS","A")
D E
I APCLFORM="D" Q $P(APCLLAST,U)
Q APCLLAST
;
LASTDFE(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last diabetic FOOT exam
; Return the last recorded DIABETIC FOOT exam:
; - V Exam Diabetic FOOT Exam
;
; Input:
; APCLPDFN - Patient DFN
; APCLBD - beginning date to begin search for value - if blank, default is DOB
; APCLED - ending date of search - if blank, default is DT
; APCLFORM - APCLFORM returned: D - return date only - example 3070801
; A - return value:
; date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
; Default if blank is D
; Output:
; If APCLFORM is blank or APCLFORM is D returns internal fileman date if one found otherwise returns null
; If APCLFORM is A returns the string:
; date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
;
I $G(APCLPDFN)="" Q ""
I $G(APCLBD)="" S APCLBD=$$DOB^AUPNPAT(APCLPDFN)
I $G(APCLED)="" S APCLED=DT
I $G(APCLFORM)="" S APCLFORM="D"
NEW APCLLAST,APCLVAL,APCLX,R,X,Y,V,E,T,G,APCLY,APCLF
S APCLLAST=""
S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"28","EXAM",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
D E
I APCLFORM="D" Q $P(APCLLAST,U)
Q APCLLAST
;
LASTRECT(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last RECTAL exam
; Return the last recorded RECTAL exam:
; - V Exam Rectal Exam 14
; - V POV V76.41, V76.44
; - V Procedure 89.34
; - V CPT G0102;S0601;S0605
;
; Input:
; APCLPDFN - Patient DFN
; APCLBD - beginning date to begin search for value - if blank, default is DOB
; APCLED - ending date of search - if blank, default is DT
; APCLFORM - APCLFORM returned: D - return date only - example 3070801
; A - return value:
; date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
; Default if blank is D
; Output:
; If APCLFORM is blank or APCLFORM is D returns internal fileman date if one found otherwise returns null
; If APCLFORM is A returns the string:
; date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
;
I $G(APCLPDFN)="" Q ""
I $G(APCLBD)="" S APCLBD=$$DOB^AUPNPAT(APCLPDFN)
I $G(APCLED)="" S APCLED=DT
I $G(APCLFORM)="" S APCLFORM="D"
NEW APCLLAST,APCLVAL,APCLX,R,X,Y,V,E,T,G,APCLY,APCLF
S APCLLAST=""
S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"14","EXAM",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
D E
S APCLVAL=$$LASTDXT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"APCH RECTAL EXAM DXS","A")
D E
S APCLVAL=$$LASTPRCT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"APCH RECTAL EXAM PROCS","A")
D E
S APCLVAL=$$LASTCPTI^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"G0102;S0601;S0605","A")
D E
I APCLFORM="D" Q $P(APCLLAST,U)
Q APCLLAST
;
LASTPELV(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last PELVIC exam
; Return the last recorded PELVIC exam:
; - V Exam Pelvic Exam 15
; - V POV V72.31, V72.32
; - V CPT G0101
;
; Input:
; APCLPDFN - Patient DFN
; APCLBD - beginning date to begin search for value - if blank, default is DOB
; APCLED - ending date of search - if blank, default is DT
; APCLFORM - APCLFORM returned: D - return date only - example 3070801
; A - return value:
; date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
; Default if blank is D
; Output:
; If APCLFORM is blank or APCLFORM is D returns internal fileman date if one found otherwise returns null
; If APCLFORM is A returns the string:
; date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
;
I $G(APCLPDFN)="" Q ""
I $G(APCLBD)="" S APCLBD=$$DOB^AUPNPAT(APCLPDFN)
I $G(APCLED)="" S APCLED=DT
I $G(APCLFORM)="" S APCLFORM="D"
NEW APCLLAST,APCLVAL,APCLX,R,X,Y,V,E,T,G,APCLY,APCLF
S APCLLAST=""
S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"15","EXAM",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
D E
S APCLVAL=$$LASTDXT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"APCH PELVIC EXAM DXS","A")
D E
;S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"V72.32","DX",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
;D E
S APCLVAL=$$LASTCPTI^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"G0101","A")
D E
I APCLFORM="D" Q $P(APCLLAST,U)
Q APCLLAST
;
LASTPHYS(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last PHYSICAL exam
; Return the last recorded PHYSICAL exam:
; - V Exam Physical Exam 01
; - V POV [SURVEILLANCE PHYSICAL EXAM] taxonomy
; - V CPT [APCH PHYSICAL EXAM CPTS] taxonomy
;
; Input:
; APCLPDFN - Patient DFN
; APCLBD - beginning date to begin search for value - if blank, default is DOB
; APCLED - ending date of search - if blank, default is DT
; APCLFORM - APCLFORM returned: D - return date only - example 3070801
; A - return value:
; date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
; Default if blank is D
; Output:
; If APCLFORM is blank or APCLFORM is D returns internal fileman date if one found otherwise returns null
; If APCLFORM is A returns the string:
; date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
;
I $G(APCLPDFN)="" Q ""
I $G(APCLBD)="" S APCLBD=$$DOB^AUPNPAT(APCLPDFN)
I $G(APCLED)="" S APCLED=DT
I $G(APCLFORM)="" S APCLFORM="D"
NEW APCLLAST,APCLVAL,APCLX,R,X,Y,V,E,T,G,APCLY,APCLF
S APCLLAST=""
S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"01","EXAM",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
D E
S APCLVAL=$$LASTDXT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"SURVEILLANCE PHYSICAL EXAM","A")
D E
S APCLVAL=$$LASTCPTT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"APCH GENERAL EXAM CPTS","A")
D E
I APCLFORM="D" Q $P(APCLLAST,U)
Q APCLLAST
;
APCLAPI2 ; IHS/CMI/LAB - visit data ;
+1 ;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
+2 ;IHS/TUCSON/LAB - added G parameter to provider call
+3 ;
+4 ;
+5 ;BJPC v1.0 patch 1
+6 ;
LASTFRA(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last FALL RISK ASSESSMENT
+1 ; Return the last recorded FALL RISK ASSESSMENT:
+2 ; - V Exam - 37 Fall Risk Exam
+3 ; - Diagnosis - V POV V15.88 OR BGP ABNORMAL GAIT OR MOBILITY taxonomy
+4 ; - V POV: Ecode in BGP FALL RELATED E-CODES taxonomy
+5 ;
+6 ; Input:
+7 ; APCLPDFN - Patient DFN
+8 ; APCLBD - beginning date to begin search for value - if blank, default is DOB
+9 ; APCLED - ending date of search - if blank, default is DT
+10 ; APCLFORM - APCLFORM returned: D - return date only - example 3070801
+11 ; A - return value:
+12 ; date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
+13 ; Default if blank is D
+14 ; Output:
+15 ; If APCLFORM is blank or APCLFORM is D returns internal fileman date if one found otherwise returns null
+16 ; If APCLFORM is A returns the string:
+17 ; date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
+18 ;
+19 IF $GET(APCLPDFN)=""
QUIT ""
+20 IF $GET(APCLBD)=""
SET APCLBD=$$DOB^AUPNPAT(APCLPDFN)
+21 IF $GET(APCLED)=""
SET APCLED=DT
+22 IF $GET(APCLFORM)=""
SET APCLFORM="D"
+23 NEW APCLLAST,APCLVAL,APCLX,R,X,Y,V,E,T,G,APCLY,APCLF,APCLZ
+24 SET APCLLAST=""
+25 SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,37,"EXAM",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")
+26 DO E
+27 SET APCLVAL=$$LASTDXT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"BGP HISTORY OF FALL DXS","A")
+28 DO E
+29 SET APCLVAL=$$LASTDXT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"BGP ABNORMAL GAIT OR MOBILITY","A")
+30 DO E
+31 SET Y="APCLZ("
+32 KILL APCLZ
+33 SET X=APCLPDFN_"^ALL DX;DURING "_$$FMADD^XLFDT(APCLED,-365)_"-"_DT
SET E=$$START1^APCLDF(X,Y)
+34 SET G=""
+35 SET T=$ORDER(^ATXAX("B","BGP FALL RELATED E-CODES",0))
+36 SET X=0
FOR
SET X=$ORDER(APCLZ(X))
IF X'=+X
QUIT
Begin DoDot:1
+37 SET G=""
SET Y=+$PIECE(APCLZ(X),U,4)
SET D=$PIECE(^AUPNVPOV(Y,0),U)
+38 IF $PIECE(^AUPNVPOV(Y,0),U,9)=""
IF $PIECE(^AUPNVPOV(Y,0),U,18)=""
IF $PIECE(^AUPNVPOV(Y,0),U,19)=""
QUIT
+39 SET E=$PIECE(^AUPNVPOV(Y,0),U,9)
IF E
IF $$ICD^ATXAPI(E,T,9)
DO VPVE
QUIT
+40 SET E=$PIECE(^AUPNVPOV(Y,0),U,18)
IF E
IF $$ICD^ATXAPI(E,T,9)
DO VPVE
QUIT
+41 SET E=$PIECE(^AUPNVPOV(Y,0),U,19)
IF E
IF $$ICD^ATXAPI(E,T,9)
DO VPVE
QUIT
End DoDot:1
+42 IF APCLFORM="D"
QUIT $PIECE(APCLLAST,U)
+43 QUIT APCLLAST
+44 ;
VPVE ;EP
+1 SET APCLLAST=$$VD^APCLV($PIECE(^AUPNVPOV(Y,0),U,3))_"^CAUSE CODE: "_$PIECE($$ICDDX^ICDEX(E),U,2)_"^"_$$VAL^XBDIQ1(9000010.07,Y,.04)_"^"_$PIECE(^AUPNVPOV(Y,0),U,3)_"^9000010.07^"_Y
+2 QUIT
+3 ;
E ;
+1 IF $PIECE(APCLVAL,U,1)>$PIECE(APCLLAST,U,1)
SET APCLLAST=APCLVAL
+2 QUIT
+3 ;
LASTHC(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last head circumference
+1 ; Return the last recorded HEAD CIRCUMFERENCE:
+2 ; - V Measurment HC
+3 ;
+4 ; Input:
+5 ; APCLPDFN - Patient DFN
+6 ; APCLBD - beginning date to begin search for value - if blank, default is DOB
+7 ; APCLED - ending date of search - if blank, default is DT
+8 ; APCLFORM - APCLFORM returned: D - return date only - example 3070801
+9 ; A - return value:
+10 ; date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
+11 ; Default if blank is D
+12 ; Output:
+13 ; If APCLFORM is blank or APCLFORM is D returns internal fileman date if one found otherwise returns null
+14 ; If APCLFORM is A returns the string:
+15 ; date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
+16 ;
+17 IF $GET(APCLPDFN)=""
QUIT ""
+18 IF $GET(APCLBD)=""
SET APCLBD=$$DOB^AUPNPAT(APCLPDFN)
+19 IF $GET(APCLED)=""
SET APCLED=DT
+20 IF $GET(APCLFORM)=""
SET APCLFORM="D"
+21 NEW APCLLAST,APCLVAL,APCLX,R,X,Y,V,E,T,G,APCLY,APCLF
+22 SET APCLLAST=""
+23 SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"HC","MEASUREMENT",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")
+24 DO E
+25 IF APCLFORM="D"
QUIT $PIECE(APCLLAST,U)
+26 QUIT APCLLAST
+27 ;
LASTDENT(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last dental exam
+1 ; Return the last recorded dental exam:
+2 ; - V Dental ADA code 0000 or 0190
+3 ; - V Exam 30 - Dental Exam
+4 ; - CHS visit with any ADA code
+5 ;
+6 ; Input:
+7 ; APCLPDFN - Patient DFN
+8 ; APCLBD - beginning date to begin search for value - if blank, default is DOB
+9 ; APCLED - ending date of search - if blank, default is DT
+10 ; APCLFORM - APCLFORM returned: D - return date only - example 3070801
+11 ; A - return value:
+12 ; date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
+13 ; Default if blank is D
+14 ; Output:
+15 ; If APCLFORM is blank or APCLFORM is D returns internal fileman date if one found otherwise returns null
+16 ; If APCLFORM is A returns the string:
+17 ; date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
+18 ;
+19 IF $GET(APCLPDFN)=""
QUIT ""
+20 IF $GET(APCLBD)=""
SET APCLBD=$$DOB^AUPNPAT(APCLPDFN)
+21 IF $GET(APCLED)=""
SET APCLED=DT
+22 IF $GET(APCLFORM)=""
SET APCLFORM="D"
+23 NEW APCLLAST,APCLVAL,APCLX,R,X,Y,V,E,T,G,APCLY,APCLF,APCLZ
+24 SET APCLLAST=""
+25 SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"0000","ADA",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")
+26 DO E
+27 SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"0190","ADA",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")
+28 DO E
+29 SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,30,"EXAM",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")
+30 DO E
+31 ;now check CHS visits for any ADA
+32 KILL APCLY
+33 SET X=APCLPDFN_"^ALL ADA;DURING "_$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD)_"-"_APCLED
SET E=$$START1^APCLDF(X,"APCLZ(")
+34 SET X=0
FOR
SET X=$ORDER(APCLZ(X))
IF X'=+X
QUIT
Begin DoDot:1
+35 SET V=$PIECE(APCLZ(X),U,4)
+36 IF $PIECE($GET(^AUPNVSIT(V,0)),U,3)'="C"
QUIT
+37 SET APCLVAL=$PIECE(APCLZ(X),U)_"^ADA: "_$PIECE(APCLZ(X),U,2)_"^^"_$PIECE(APCLZ(X),U,5)_"^9000010.05^"_+$PIECE(APCLZ(X),U,4)
+38 DO E
End DoDot:1
+39 IF APCLFORM="D"
QUIT $PIECE(APCLLAST,U)
+40 QUIT APCLLAST
+41 ;
LASTDEYE(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last diabetic eye exam
+1 ; Return the last recorded DIABETIC EYE exam:
+2 ; - V Exam Diabetic Eye Exam
+3 ; - V CPT 92250, 92012, 92014, 92002, 2022F, 2024F, 2026F, S3000
+4 ;
+5 ; Input:
+6 ; APCLPDFN - Patient DFN
+7 ; APCLBD - beginning date to begin search for value - if blank, default is DOB
+8 ; APCLED - ending date of search - if blank, default is DT
+9 ; APCLFORM - APCLFORM returned: D - return date only - example 3070801
+10 ; A - return value:
+11 ; date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
+12 ; Default if blank is D
+13 ; Output:
+14 ; If APCLFORM is blank or APCLFORM is D returns internal fileman date if one found otherwise returns null
+15 ; If APCLFORM is A returns the string:
+16 ; date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
+17 ;
+18 IF $GET(APCLPDFN)=""
QUIT ""
+19 IF $GET(APCLBD)=""
SET APCLBD=$$DOB^AUPNPAT(APCLPDFN)
+20 IF $GET(APCLED)=""
SET APCLED=DT
+21 IF $GET(APCLFORM)=""
SET APCLFORM="D"
+22 NEW APCLLAST,APCLVAL,APCLX,R,X,Y,V,E,T,G,APCLY,APCLF
+23 SET APCLLAST=""
+24 SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"03","EXAM",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")
+25 DO E
+26 SET APCLVAL=$$LASTCPTT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"APCH DIABETIC EYE EXAM CPTS","A")
+27 DO E
+28 IF APCLFORM="D"
QUIT $PIECE(APCLLAST,U)
+29 QUIT APCLLAST
+30 ;
LASTDFE(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last diabetic FOOT exam
+1 ; Return the last recorded DIABETIC FOOT exam:
+2 ; - V Exam Diabetic FOOT Exam
+3 ;
+4 ; Input:
+5 ; APCLPDFN - Patient DFN
+6 ; APCLBD - beginning date to begin search for value - if blank, default is DOB
+7 ; APCLED - ending date of search - if blank, default is DT
+8 ; APCLFORM - APCLFORM returned: D - return date only - example 3070801
+9 ; A - return value:
+10 ; date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
+11 ; Default if blank is D
+12 ; Output:
+13 ; If APCLFORM is blank or APCLFORM is D returns internal fileman date if one found otherwise returns null
+14 ; If APCLFORM is A returns the string:
+15 ; date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
+16 ;
+17 IF $GET(APCLPDFN)=""
QUIT ""
+18 IF $GET(APCLBD)=""
SET APCLBD=$$DOB^AUPNPAT(APCLPDFN)
+19 IF $GET(APCLED)=""
SET APCLED=DT
+20 IF $GET(APCLFORM)=""
SET APCLFORM="D"
+21 NEW APCLLAST,APCLVAL,APCLX,R,X,Y,V,E,T,G,APCLY,APCLF
+22 SET APCLLAST=""
+23 SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"28","EXAM",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")
+24 DO E
+25 IF APCLFORM="D"
QUIT $PIECE(APCLLAST,U)
+26 QUIT APCLLAST
+27 ;
LASTRECT(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last RECTAL exam
+1 ; Return the last recorded RECTAL exam:
+2 ; - V Exam Rectal Exam 14
+3 ; - V POV V76.41, V76.44
+4 ; - V Procedure 89.34
+5 ; - V CPT G0102;S0601;S0605
+6 ;
+7 ; Input:
+8 ; APCLPDFN - Patient DFN
+9 ; APCLBD - beginning date to begin search for value - if blank, default is DOB
+10 ; APCLED - ending date of search - if blank, default is DT
+11 ; APCLFORM - APCLFORM returned: D - return date only - example 3070801
+12 ; A - return value:
+13 ; date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
+14 ; Default if blank is D
+15 ; Output:
+16 ; If APCLFORM is blank or APCLFORM is D returns internal fileman date if one found otherwise returns null
+17 ; If APCLFORM is A returns the string:
+18 ; date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
+19 ;
+20 IF $GET(APCLPDFN)=""
QUIT ""
+21 IF $GET(APCLBD)=""
SET APCLBD=$$DOB^AUPNPAT(APCLPDFN)
+22 IF $GET(APCLED)=""
SET APCLED=DT
+23 IF $GET(APCLFORM)=""
SET APCLFORM="D"
+24 NEW APCLLAST,APCLVAL,APCLX,R,X,Y,V,E,T,G,APCLY,APCLF
+25 SET APCLLAST=""
+26 SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"14","EXAM",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")
+27 DO E
+28 SET APCLVAL=$$LASTDXT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"APCH RECTAL EXAM DXS","A")
+29 DO E
+30 SET APCLVAL=$$LASTPRCT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"APCH RECTAL EXAM PROCS","A")
+31 DO E
+32 SET APCLVAL=$$LASTCPTI^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"G0102;S0601;S0605","A")
+33 DO E
+34 IF APCLFORM="D"
QUIT $PIECE(APCLLAST,U)
+35 QUIT APCLLAST
+36 ;
LASTPELV(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last PELVIC exam
+1 ; Return the last recorded PELVIC exam:
+2 ; - V Exam Pelvic Exam 15
+3 ; - V POV V72.31, V72.32
+4 ; - V CPT G0101
+5 ;
+6 ; Input:
+7 ; APCLPDFN - Patient DFN
+8 ; APCLBD - beginning date to begin search for value - if blank, default is DOB
+9 ; APCLED - ending date of search - if blank, default is DT
+10 ; APCLFORM - APCLFORM returned: D - return date only - example 3070801
+11 ; A - return value:
+12 ; date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
+13 ; Default if blank is D
+14 ; Output:
+15 ; If APCLFORM is blank or APCLFORM is D returns internal fileman date if one found otherwise returns null
+16 ; If APCLFORM is A returns the string:
+17 ; date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
+18 ;
+19 IF $GET(APCLPDFN)=""
QUIT ""
+20 IF $GET(APCLBD)=""
SET APCLBD=$$DOB^AUPNPAT(APCLPDFN)
+21 IF $GET(APCLED)=""
SET APCLED=DT
+22 IF $GET(APCLFORM)=""
SET APCLFORM="D"
+23 NEW APCLLAST,APCLVAL,APCLX,R,X,Y,V,E,T,G,APCLY,APCLF
+24 SET APCLLAST=""
+25 SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"15","EXAM",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")
+26 DO E
+27 SET APCLVAL=$$LASTDXT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"APCH PELVIC EXAM DXS","A")
+28 DO E
+29 ;S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"V72.32","DX",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
+30 ;D E
+31 SET APCLVAL=$$LASTCPTI^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"G0101","A")
+32 DO E
+33 IF APCLFORM="D"
QUIT $PIECE(APCLLAST,U)
+34 QUIT APCLLAST
+35 ;
LASTPHYS(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last PHYSICAL exam
+1 ; Return the last recorded PHYSICAL exam:
+2 ; - V Exam Physical Exam 01
+3 ; - V POV [SURVEILLANCE PHYSICAL EXAM] taxonomy
+4 ; - V CPT [APCH PHYSICAL EXAM CPTS] taxonomy
+5 ;
+6 ; Input:
+7 ; APCLPDFN - Patient DFN
+8 ; APCLBD - beginning date to begin search for value - if blank, default is DOB
+9 ; APCLED - ending date of search - if blank, default is DT
+10 ; APCLFORM - APCLFORM returned: D - return date only - example 3070801
+11 ; A - return value:
+12 ; date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
+13 ; Default if blank is D
+14 ; Output:
+15 ; If APCLFORM is blank or APCLFORM is D returns internal fileman date if one found otherwise returns null
+16 ; If APCLFORM is A returns the string:
+17 ; date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
+18 ;
+19 IF $GET(APCLPDFN)=""
QUIT ""
+20 IF $GET(APCLBD)=""
SET APCLBD=$$DOB^AUPNPAT(APCLPDFN)
+21 IF $GET(APCLED)=""
SET APCLED=DT
+22 IF $GET(APCLFORM)=""
SET APCLFORM="D"
+23 NEW APCLLAST,APCLVAL,APCLX,R,X,Y,V,E,T,G,APCLY,APCLF
+24 SET APCLLAST=""
+25 SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"01","EXAM",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")
+26 DO E
+27 SET APCLVAL=$$LASTDXT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"SURVEILLANCE PHYSICAL EXAM","A")
+28 DO E
+29 SET APCLVAL=$$LASTCPTT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"APCH GENERAL EXAM CPTS","A")
+30 DO E
+31 IF APCLFORM="D"
QUIT $PIECE(APCLLAST,U)
+32 QUIT APCLLAST
+33 ;
