Routine: APCLAPI2

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

E ;

 I $P(APCLVAL,U,1)>$P(APCLLAST,U,1) S APCLLAST=APCLVAL

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      ;

APCLAPI2.m