Routine: APCLAPI5

APCLAPI5 ; IHS/CMI/LAB - visit data ;

 ;;2.0;IHS PCC SUITE;**2,11**;MAY 14, 2009;Build 58

 ;IHS/TUCSON/LAB - added G parameter to provider call

LASTCHLA(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last CHLAMYDIA SCREENING

 ;  Return the last recorded CHLAMYDIA SCREENING:

 ;   - Diagnosis - V POV V73.88, V73.98

 ;   - V CPT:  BGP CHLAMYDIA CPTS taxonomy

 ;   - V LAB : BGP CHLAMYDIA TESTS TAX, BGP CHLAMYDIA LOINC CODES

 ;  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

 S APCLLAST=""

 S APCLVAL=$$LASTDXT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"BGP CHLAMYDIA SCREEN DXS","A")

D E

 ;S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"V73.98","DX",$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,"BGP CHLAMYDIA CPTS","A")

D E

 S APCLVAL=$$LASTLAB^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,,$O(^ATXLAB("B","BGP CHLAMYDIA TESTS TAX",0)),,$O(^ATXAX("B","BGP CHLAMYDIA LOINC CODES",0)),"A")

D E

 I APCLFORM="D" Q $P(APCLLAST,U)

 Q APCLLAST

VR ;EP

 S APCLLAST=$P(Y,U,1)_"^"_$P($$CPT^ICPTCOD(Y),U,2)_" "_$$VAL^XBDIQ1(9000010.22,.01,X)_"^^"_$P(^AUPNVRAD(X,0),U,3)_"^9000010.22^"_X

E ;

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

LASTHIVS(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - LAST HIV SCREENING

 ;  Return the last recorded HIV SCREENING:

 ;   - V CPT:  BGP CPT HIV TESTS taxonomy

 ;   - V LAB : BGP HIV TEST TAX, BGP HIV TEST LOINC CODES

 ;  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

 S APCLLAST=""

 S APCLVAL=$$LASTCPTT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"BGP CPT HIV TESTS","A")

D E

 S APCLVAL=$$LASTLAB^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,,$O(^ATXLAB("B","BGP HIV TEST TAX",0)),,$O(^ATXAX("B","BGP HIV TEST LOINC CODES",0)),"A")

D E

 I APCLFORM="D" Q $P(APCLLAST,U)

 Q APCLLAST

LASTNBHS(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last HEARING EXAM

 ;  Return the last recorded HEARING EXAM:

 ;   - V Exam 38&39

 ;   - V POV V72.1

 ;   - V CPT [APCH NEWBORN HEAR SCRN CPTS]

 ;   - V CPT [APCH HEARING SCREEN CPTS]

 ;   - V POV [APCH HEARLING LOSS DXS]

 ;  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,APCLRE,APCLLE

 S APCLLAST=""

 S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"38","EXAM",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A") I APCLVAL S APCLRE=1

D E

 S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"39","EXAM",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A") I APCLVAL S APCLLE=1

D E

 I '$G(APCLRE) S APCLLAST=""

 I '$G(APCLLE) S APCLLAST=""

 S APCLVAL=$$LASTCPTT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"APCH NEWBORN HEAR SCRN CPTS","A")

D E

 S APCLVAL=$$LASTDXT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"APCH HEARING EXAM DXS","A")

D E

 S APCLVAL=$$LASTDXT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"APCH HEARING LOSS DXS","A")

D E

 S APCLVAL=$$LASTCPTT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"APCH HEARING SCREEN CPTS","A")

D E

 I APCLFORM="D" Q $P(APCLLAST,U)

 Q APCLLAST

LASTNUTR(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last NUTRITION SCRFEENING

 ;  Return the last recorded NUTRITION SCREENING EXAM:

 ;   - V Nutrition Screening

 ;  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,APCLRE,APCLLE

 S APCLLAST=""

 S X=0 F  S X=$O(^AUPNVNTS("AC",APCLPDFN,X)) Q:X'=+X  D

 .Q:'$D(^AUPNVNTS(X))

 .S V=$P(^AUPNVNTS(X,0),U,3)

 .Q:'X

 .Q:'$D(^AUPNVSIT(V,0))

 .S V=$$VD^APCLV(V)

 .Q:V<APCLBD

 .Q:V>APCLED

 .I V>$P(APCLLAST,U,1) S APCLLAST=V_U_"NUTRITION SCREENING EXAM"_U_U_$P(^AUPNVNTS(X,0),U,3)_U_9000010.49_U_X

 I APCLFORM="D" Q $P(APCLLAST,U,1)

 Q APCLLAST

APCLAPI5  ; IHS/CMI/LAB - visit data ;

 +1       ;;2.0;IHS PCC SUITE;**2,11**;MAY 14, 2009;Build 58

 +2       ;IHS/TUCSON/LAB - added G parameter to provider call

 +3       ;

 +4       ;

 +5       ;

LASTCHLA(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last CHLAMYDIA SCREENING

 +1       ;  Return the last recorded CHLAMYDIA SCREENING:

 +2       ;   - Diagnosis - V POV V73.88, V73.98

 +3       ;   - V CPT:  BGP CHLAMYDIA CPTS taxonomy

 +4       ;   - V LAB : BGP CHLAMYDIA TESTS TAX, BGP CHLAMYDIA LOINC CODES

 +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

 +24       SET APCLLAST=""

 +25       SET APCLVAL=$$LASTDXT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"BGP CHLAMYDIA SCREEN DXS","A")

 +26       DO E

 +27      ;S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"V73.98","DX",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")

 +28      ;D E

 +29       SET APCLVAL=$$LASTCPTT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"BGP CHLAMYDIA CPTS","A")

 +30       DO E

 +31       SET APCLVAL=$$LASTLAB^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,,$ORDER(^ATXLAB("B","BGP CHLAMYDIA TESTS TAX",0)),,$ORDER(^ATXAX("B","BGP CHLAMYDIA LOINC CODES",0)),"A")

 +32       DO E

 +33       IF APCLFORM="D"

               QUIT $PIECE(APCLLAST,U)

 +34       QUIT APCLLAST

 +35      ;

VR        ;EP

 +1        SET APCLLAST=$PIECE(Y,U,1)_"^"_$PIECE($$CPT^ICPTCOD(Y),U,2)_" "_$$VAL^XBDIQ1(9000010.22,.01,X)_"^^"_$PIECE(^AUPNVRAD(X,0),U,3)_"^9000010.22^"_X

 +2        QUIT

 +3       ;

E         ;

 +1        IF $PIECE(APCLVAL,U,1)>$PIECE(APCLLAST,U,1)

               SET APCLLAST=APCLVAL

 +2        QUIT

LASTHIVS(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - LAST HIV SCREENING

 +1       ;

 +2       ;  Return the last recorded HIV SCREENING:

 +3       ;

 +4       ;   - V CPT:  BGP CPT HIV TESTS taxonomy

 +5       ;   - V LAB : BGP HIV TEST TAX, BGP HIV TEST LOINC CODES

 +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

 +25       SET APCLLAST=""

 +26       SET APCLVAL=$$LASTCPTT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"BGP CPT HIV TESTS","A")

 +27       DO E

 +28       SET APCLVAL=$$LASTLAB^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,,$ORDER(^ATXLAB("B","BGP HIV TEST TAX",0)),,$ORDER(^ATXAX("B","BGP HIV TEST LOINC CODES",0)),"A")

 +29       DO E

 +30       IF APCLFORM="D"

               QUIT $PIECE(APCLLAST,U)

 +31       QUIT APCLLAST

LASTNBHS(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last HEARING EXAM

 +1       ;  Return the last recorded HEARING EXAM:

 +2       ;   - V Exam 38&39

 +3       ;   - V POV V72.1

 +4       ;   - V CPT [APCH NEWBORN HEAR SCRN CPTS]

 +5       ;   - V CPT [APCH HEARING SCREEN CPTS]

 +6       ;   - V POV [APCH HEARLING LOSS DXS]

 +7       ;

 +8       ;

 +9       ;  Input:

 +10      ;   APCLPDFN - Patient DFN

 +11      ;   APCLBD - beginning date to begin search for value - if blank, default is DOB

 +12      ;   APCLED - ending date of search - if blank, default is DT

 +13      ;   APCLFORM -  APCLFORM returned:  D - return date only - example 3070801

 +14      ;                                 A - return value:

 +15      ;                       date^text of item found^value if appropriate^visit ien^File found in^ien of file found in

 +16      ;             Default if blank is D

 +17      ;  Output:

 +18      ;   If APCLFORM is blank or APCLFORM is D returns internal fileman date if one found otherwise returns null

 +19      ;   If APCLFORM is A returns the string:

 +20      ;     date^text of item found^value if appropriate^visit ien^File found in^ien of file found in

 +21      ;

 +22       IF $GET(APCLPDFN)=""

               QUIT ""

 +23       IF $GET(APCLBD)=""

               SET APCLBD=$$DOB^AUPNPAT(APCLPDFN)

 +24       IF $GET(APCLED)=""

               SET APCLED=DT

 +25       IF $GET(APCLFORM)=""

               SET APCLFORM="D"

 +26       NEW APCLLAST,APCLVAL,APCLX,R,X,Y,V,E,T,G,APCLY,APCLF,APCLRE,APCLLE

 +27       SET APCLLAST=""

 +28       SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"38","EXAM",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")

           IF APCLVAL

               SET APCLRE=1

 +29       DO E

 +30       SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"39","EXAM",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")

           IF APCLVAL

               SET APCLLE=1

 +31       DO E

 +32       IF '$GET(APCLRE)

               SET APCLLAST=""

 +33       IF '$GET(APCLLE)

               SET APCLLAST=""

 +34       SET APCLVAL=$$LASTCPTT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"APCH NEWBORN HEAR SCRN CPTS","A")

 +35       DO E

 +36       SET APCLVAL=$$LASTDXT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"APCH HEARING EXAM DXS","A")

 +37       DO E

 +38       SET APCLVAL=$$LASTDXT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"APCH HEARING LOSS DXS","A")

 +39       DO E

 +40       SET APCLVAL=$$LASTCPTT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"APCH HEARING SCREEN CPTS","A")

 +41       DO E

 +42       IF APCLFORM="D"

               QUIT $PIECE(APCLLAST,U)

 +43       QUIT APCLLAST

LASTNUTR(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last NUTRITION SCRFEENING

 +1       ;  Return the last recorded NUTRITION SCREENING EXAM:

 +2       ;   - V Nutrition Screening

 +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,APCLRE,APCLLE

 +22       SET APCLLAST=""

 +23       SET X=0

FOR

               SET X=$ORDER(^AUPNVNTS("AC",APCLPDFN,X))

               IF X'=+X

                   QUIT

               Begin DoDot:1

 +24               IF '$DATA(^AUPNVNTS(X))

                       QUIT

 +25               SET V=$PIECE(^AUPNVNTS(X,0),U,3)

 +26               IF 'X

                       QUIT

 +27               IF '$DATA(^AUPNVSIT(V,0))

                       QUIT

 +28               SET V=$$VD^APCLV(V)

 +29               IF V<APCLBD

                       QUIT

 +30               IF V>APCLED

                       QUIT

 +31               IF V>$PIECE(APCLLAST,U,1)

                       SET APCLLAST=V_U_"NUTRITION SCREENING EXAM"_U_U_$PIECE(^AUPNVNTS(X,0),U,3)_U_9000010.49_U_X

               End DoDot:1

 +32       IF APCLFORM="D"

               QUIT $PIECE(APCLLAST,U,1)

 +33       QUIT APCLLAST

APCLAPI5.m