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
Q
;
E ;
I $P(APCLVAL,U,1)>$P(APCLLAST,U,1) S APCLLAST=APCLVAL
Q
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
