APCLAPI ; IHS/CMI/LAB - visit data ; 25 Feb 2011 11:02 AM
;;2.0;IHS PCC SUITE;**6,8,11,14,16**;MAY 14, 2009;Build 9
;
LASTALC(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last alcohol screen
; Return the last recorded alcohol screening value:
; - V Exam 35 or Behavioral Health Module Alcohol Screening
; - V measurement AUDC, AUDT, CRFT
; - Health Factor with Alcohol/Drug Category (CAGE)
; - Diagnosis - V POV V79.1
; - Education Topics - V EDUCATION or Behavioral Health Module
; AOD-SCR
; CD-SCR
; - Behavioral Health Module Diagnosis (POV) of 29.1
; - cpts in BGP ALCOHOL SCREENING CPTS taxonomy
; - V POV snomed PXRM BQI ALCOHOL 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
S APCLLAST=""
S APCLVAL=$$LASTALCS(APCLPDFN,APCLBD,APCLED,"A")
D E
S APCLVAL=$$LASTHF^APCLAPIU(APCLPDFN,"ALCOHOL/DRUG",$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 SCREEN FOR ALCOHOLISM DX","A")
D E
S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"AUDC","MEASUREMENT",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
D E
S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"AUDT","MEASUREMENT",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
D E
S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"CRFT","MEASUREMENT",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
D E
S APCLX=0 F S APCLX=$O(^AUTTEDT("C","AOD-SCR",APCLX)) Q:APCLX'=+APCLX D
.S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"`"_APCLX,"EDUCATION",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
.D E
S APCLX=0 F S APCLX=$O(^AUTTEDT("C","CD-SCR",APCLX)) Q:APCLX'=+APCLX D
.S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"`"_APCLX,"EDUCATION",$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 ALCOHOL SCREENING CPTS","A")
D E
S APCLVAL=$$SNOMEDPV^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"PXRM BQI ALCOHOL SCREENING","A")
D E
S APCLVAL=$$LASTBHDX^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"29.1","A")
D E
S APCLVAL=$$LASTBHED^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"AOD-SCR","A")
D E
S APCLVAL=$$LASTBHED^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"CD-SCR","A")
D E
S APCLVAL=$$LASTBHME^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"AUDC","A")
D E
S APCLVAL=$$LASTBHME^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"AUDT","A")
D E
S APCLVAL=$$LASTBHME^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"CRFT","A")
D E
I APCLFORM="D" Q $P(APCLLAST,U)
Q APCLLAST
;
VE(Y,F,T) ;EP
Q $P(Y,U,1)_"^Exam: "_$P(Y,U,3)_"^"_$$VAL^XBDIQ1(9000010.13,+$P(Y,U,4),.04)_"^"_$P(Y,U,5)_"^9000010.13^"_+$P(Y,U,4)
;
LASTALCS(P,BD,ED,F) ;
;look for last exam in v exam or bh between bd and ed
NEW %,E,D,V,X,G
NEW APCLG,APCLX,APCLC,APCLV
S %=P_"^LAST EXAM 35;DURING "_BD_"-"_ED,E=$$START1^APCLDF(%,"APCLG(")
I $D(APCLG(1)) S APCLX(9999999-$P(APCLG(1),U))=$$VE(APCLG(1))
;AMHREC field
S APCLC=0,APCLV=""
S E=(9999999-BD),D=9999999-ED-1_".99" F S D=$O(^AMHREC("AE",P,D)) Q:D'=+D!(APCLC)!($P(D,".")>E) S V=0 F S V=$O(^AMHREC("AE",P,D,V)) Q:V'=+V!(APCLC) D
.S X=$P($G(^AMHREC(V,14)),U,3)
.I X="" Q ;no test
.I $E(X)="U" Q ;don't count refusal here
.I X="REF" Q
.S G=9999999-$P(D,".")
.Q:$D(APCLX($P(D,".")))
.S APCLX($P(D,"."))=G_"^BH: ALCOHOL SCREENING^"_$$VAL^XBDIQ1(9002011,V,1403)_"^^9002011^"_V
I $O(APCLX(0)) S G=$O(APCLX(0)) Q $S(F="D":$P(APCLX(G),U,1),1:APCLX(G))
Q ""
;
E ;
I $P(APCLVAL,U,1)>$P(APCLLAST,U,1) S APCLLAST=APCLVAL
Q
;
LASTDEPS(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - return last depression screen
; Return the last recorded depression screening value:
; - V Exam 36 or Behavioral Health Module Depression Screening
; - Diagnosis - V POV V79.0
; - Education Topics - V EDUCATION or Behavioral Health Module
; DEP-SCR
; - V Measurement PHQ2, PHQ9, PHQT
; - Behavioral Health Module Diagnosis (POV) of 14.1
; - Diagnosis in BGP MOOD DISORDERS taxonomy in V POV
; - Diagnosis in BGP MOOD DISORDERS taxonomy in BH
; - Problem Code of 14 or 15 in BH
; - V POV snomed PXRM BQI DEPRESSION 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(APCLBD)="" S APCLBD=$$DOB^AUPNPAT(APCLPDFN)
I $G(APCLED)="" S APCLED=DT
I $G(APCLFORM)="" S APCLFORM="D"
NEW APCLLAST,APCLVAL,APCLX
S APCLLAST=""
S APCLVAL=$$LASTDEP(APCLPDFN,APCLBD,APCLED,"A")
D E
S APCLVAL=$$LASTDXT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"BGP DEPRESSION SCRN DXS","A")
D E
S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"PHQ2","MEASUREMENT",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
D E
S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"PHQ9","MEASUREMENT",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
D E
S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"PHQT","MEASUREMENT",$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 DEPRESSION SCREEN CPTS","A")
D E
S APCLX=0 F S APCLX=$O(^AUTTEDT("C","DEP-SCR",APCLX)) Q:APCLX'=+APCLX D
.S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"`"_APCLX,"EDUCATION",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
.D E
S APCLVAL=$$SNOMEDPV^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"PXRM BQI DEPRESSION SCREENING","A")
D E
S APCLVAL=$$LASTBHDX^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"14.1","A")
D E
S APCLVAL=$$LASTBHED^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"DEP-SCR","A")
D E
;now check for mood disorders
S APCLVAL=$$LASTDXT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"BGP MOOD DISORDERS","A")
D E
S APCLVAL=$$LASTBHDT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"BGP MOOD DISORDERS","A")
D E
S APCLVAL=$$LASTBHDX^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"14","A")
D E
S APCLVAL=$$LASTBHDX^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"15","A")
D E
S APCLVAL=$$LASTBHME^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"PHQ2","A")
D E
S APCLVAL=$$LASTBHME^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"PHQ9","A")
D E
S APCLVAL=$$LASTBHME^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"PHQT","A")
D E
I APCLFORM="D" Q $P(APCLLAST,U)
Q APCLLAST
;
LASTDEP(P,BD,ED,F) ;
NEW %,E,D,V,X,G
NEW APCLG,APCLX,APCLC,APCLV
S %=P_"^LAST EXAM 36;DURING "_BD_"-"_ED,E=$$START1^APCLDF(%,"APCLG(")
I $D(APCLG(1)) S APCLX(9999999-$P(APCLG(1),U))=$$VE(APCLG(1))
;now look at AMHREC
S APCLC=0,APCLV=""
S E=(9999999-BD),D=9999999-ED-1_".99" F S D=$O(^AMHREC("AE",P,D)) Q:D'=+D!(APCLC)!($P(D,".")>E) S V=0 F S V=$O(^AMHREC("AE",P,D,V)) Q:V'=+V!(APCLC) D
.S X=$P($G(^AMHREC(V,14)),U,5)
.I X="" Q ;no test
.I $E(X)="U" Q ;don't count refusal here
.I X="REF" Q
.S G=9999999-$P(D,".")
.Q:$D(APCLX($P(D,".")))
.S APCLX($P(D,"."))=G_"^BH: DEPRESSION SCREENING^"_$$VAL^XBDIQ1(9002011,V,1405)_"^^9002011^"_V
I $O(APCLX(0)) S G=$O(APCLX(0)) Q $S(F="D":$P(APCLX(G),U,1),1:APCLX(G))
Q ""
;
LASTIPVS(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last ipv screen
; - V Exam 34 or Behavioral Health IPV 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
S APCLLAST=""
S APCLVAL=$$LASTIPV(APCLPDFN,APCLBD,APCLED,"A")
D E
I APCLFORM="D" Q $P(APCLLAST,U)
Q APCLLAST
;
LASTIPV(P,BD,ED,APCLF) ;
NEW %,E,D,V,X,G
NEW APCLG,APCLX,APCLC,APCLV
S %=P_"^LAST EXAM 34;DURING "_BD_"-"_ED,E=$$START1^APCLDF(%,"APCLG(")
I $D(APCLG(1)) S APCLX(9999999-$P(APCLG(1),U))=$$VE(APCLG(1))
;now look at AMHREC field
S APCLC=0,APCLV=""
S E=(9999999-BD),D=9999999-ED-1_".99" F S D=$O(^AMHREC("AE",P,D)) Q:D'=+D!(APCLC)!($P(D,".")>E) S V=0 F S V=$O(^AMHREC("AE",P,D,V)) Q:V'=+V!(APCLC) D
.S X=$P($G(^AMHREC(V,14)),U,1)
.I X="" Q
.I $E(X)="U" Q ;don't count refusal here
.I X="REF" Q
.S G=9999999-$P(D,".")
.Q:$D(APCLX($P(D,".")))
.S APCLX($P(D,"."))=G_"^BH: IPV SCREENING^"_$$VAL^XBDIQ1(9002011,V,1401)_"^^9002011^"_V
I $O(APCLX(0)) S G=$O(APCLX(0)) Q $S(APCLFORM="D":$P(APCLX(G),U,1),1:APCLX(G))
Q ""
;
LASTCOLO(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - return last Colonoscopy
; - V Procedure: 45.43, 45.22, 45.23, 45.25
; - V CPT : BGP COLO 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,E,%,T
S APCLVAL="",APCLLAST=""
S APCLVAL=$$LASTPRCT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"BGP COLO PROCS","A")
D E
S APCLVAL=$$LASTCPTT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"BGP COLO CPTS","A")
D E
I APCLFORM="D" Q $P(APCLLAST,U)
Q APCLLAST
;
LASTFSIG(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - return last sigmoidoscopy
; - V Procedure: 45.24, 45.42
; - V CPT : BGP SIG 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,E,%,T
S APCLVAL="",APCLLAST=""
S APCLVAL=$$LASTPRCT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"BGP SIG PROCS","A")
D E
S APCLVAL=$$LASTCPTT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"BGP SIG CPTS","A")
D E
I APCLFORM="D" Q $P(APCLLAST,U)
Q APCLLAST
;
REMDEPS(P,APCLBD,APCLED) ;PEP - called from reminders to get data on last depression screening 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
;
; Output:
;returns the string:
; 1 or 0^date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
; piece 1: 1 if item found, 0 if no depression screening found in the date range
; 2: date of last depression screening
; 3: text of item found
; 4: value - result
; 5: visit ien on which item found
; 6: file item found in (usually a V File #)
; 7: ien of V File entry found
;
I '$G(P) Q 0
I $G(APCLBD)="" S APCLBD=$$DOB^AUPNPAT(P)
I $G(APCLED)="" S APCLED=DT
NEW APCLR
S APCLR=$$LASTDEPS(P,APCLBD,APCLED,"A")
I APCLR]"" Q 1_"^"_APCLR
Q 0
APCLAPI ; IHS/CMI/LAB - visit data ; 25 Feb 2011 11:02 AM
+1 ;;2.0;IHS PCC SUITE;**6,8,11,14,16**;MAY 14, 2009;Build 9
+2 ;
LASTALC(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last alcohol screen
+1 ; Return the last recorded alcohol screening value:
+2 ; - V Exam 35 or Behavioral Health Module Alcohol Screening
+3 ; - V measurement AUDC, AUDT, CRFT
+4 ; - Health Factor with Alcohol/Drug Category (CAGE)
+5 ; - Diagnosis - V POV V79.1
+6 ; - Education Topics - V EDUCATION or Behavioral Health Module
+7 ; AOD-SCR
+8 ; CD-SCR
+9 ; - Behavioral Health Module Diagnosis (POV) of 29.1
+10 ; - cpts in BGP ALCOHOL SCREENING CPTS taxonomy
+11 ; - V POV snomed PXRM BQI ALCOHOL SCREENING
+12 ;
+13 ; Input:
+14 ; APCLPDFN - Patient DFN
+15 ; APCLBD - beginning date to begin search for value - if blank, default is DOB
+16 ; APCLED - ending date of search - if blank, default is DT
+17 ; APCLFORM - APCLFORM returned: D - return date only - example 3070801
+18 ; A - return value:
+19 ; date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
+20 ; Default if blank is D
+21 ; Output:
+22 ; If APCLFORM is blank or APCLFORM is D returns internal fileman date if one found otherwise returns null
+23 ; If APCLFORM is A returns the string:
+24 ; date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
+25 ;
+26 IF $GET(APCLPDFN)=""
QUIT ""
+27 IF $GET(APCLBD)=""
SET APCLBD=$$DOB^AUPNPAT(APCLPDFN)
+28 IF $GET(APCLED)=""
SET APCLED=DT
+29 IF $GET(APCLFORM)=""
SET APCLFORM="D"
+30 NEW APCLLAST,APCLVAL,APCLX
+31 SET APCLLAST=""
+32 SET APCLVAL=$$LASTALCS(APCLPDFN,APCLBD,APCLED,"A")
+33 DO E
+34 SET APCLVAL=$$LASTHF^APCLAPIU(APCLPDFN,"ALCOHOL/DRUG",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")
+35 DO E
+36 SET APCLVAL=$$LASTDXT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"BGP SCREEN FOR ALCOHOLISM DX","A")
+37 DO E
+38 SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"AUDC","MEASUREMENT",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")
+39 DO E
+40 SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"AUDT","MEASUREMENT",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")
+41 DO E
+42 SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"CRFT","MEASUREMENT",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")
+43 DO E
+44 SET APCLX=0
FOR
SET APCLX=$ORDER(^AUTTEDT("C","AOD-SCR",APCLX))
IF APCLX'=+APCLX
QUIT
Begin DoDot:1
+45 SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"`"_APCLX,"EDUCATION",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")
+46 DO E
End DoDot:1
+47 SET APCLX=0
FOR
SET APCLX=$ORDER(^AUTTEDT("C","CD-SCR",APCLX))
IF APCLX'=+APCLX
QUIT
Begin DoDot:1
+48 SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"`"_APCLX,"EDUCATION",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")
+49 DO E
End DoDot:1
+50 SET APCLVAL=$$LASTCPTT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"BGP ALCOHOL SCREENING CPTS","A")
+51 DO E
+52 SET APCLVAL=$$SNOMEDPV^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"PXRM BQI ALCOHOL SCREENING","A")
+53 DO E
+54 SET APCLVAL=$$LASTBHDX^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"29.1","A")
+55 DO E
+56 SET APCLVAL=$$LASTBHED^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"AOD-SCR","A")
+57 DO E
+58 SET APCLVAL=$$LASTBHED^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"CD-SCR","A")
+59 DO E
+60 SET APCLVAL=$$LASTBHME^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"AUDC","A")
+61 DO E
+62 SET APCLVAL=$$LASTBHME^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"AUDT","A")
+63 DO E
+64 SET APCLVAL=$$LASTBHME^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"CRFT","A")
+65 DO E
+66 IF APCLFORM="D"
QUIT $PIECE(APCLLAST,U)
+67 QUIT APCLLAST
+68 ;
VE(Y,F,T) ;EP
+1 QUIT $PIECE(Y,U,1)_"^Exam: "_$PIECE(Y,U,3)_"^"_$$VAL^XBDIQ1(9000010.13,+$PIECE(Y,U,4),.04)_"^"_$PIECE(Y,U,5)_"^9000010.13^"_+$PIECE(Y,U,4)
+2 ;
LASTALCS(P,BD,ED,F) ;
+1 ;look for last exam in v exam or bh between bd and ed
+2 NEW %,E,D,V,X,G
+3 NEW APCLG,APCLX,APCLC,APCLV
+4 SET %=P_"^LAST EXAM 35;DURING "_BD_"-"_ED
SET E=$$START1^APCLDF(%,"APCLG(")
+5 IF $DATA(APCLG(1))
SET APCLX(9999999-$PIECE(APCLG(1),U))=$$VE(APCLG(1))
+6 ;AMHREC field
+7 SET APCLC=0
SET APCLV=""
+8 SET E=(9999999-BD)
SET D=9999999-ED-1_".99"
FOR
SET D=$ORDER(^AMHREC("AE",P,D))
IF D'=+D!(APCLC)!($PIECE(D,".")>E)
QUIT
SET V=0
FOR
SET V=$ORDER(^AMHREC("AE",P,D,V))
IF V'=+V!(APCLC)
QUIT
Begin DoDot:1
+9 SET X=$PIECE($GET(^AMHREC(V,14)),U,3)
+10 ;no test
IF X=""
QUIT
+11 ;don't count refusal here
IF $EXTRACT(X)="U"
QUIT
+12 IF X="REF"
QUIT
+13 SET G=9999999-$PIECE(D,".")
+14 IF $DATA(APCLX($PIECE(D,".")))
QUIT
+15 SET APCLX($PIECE(D,"."))=G_"^BH: ALCOHOL SCREENING^"_$$VAL^XBDIQ1(9002011,V,1403)_"^^9002011^"_V
End DoDot:1
+16 IF $ORDER(APCLX(0))
SET G=$ORDER(APCLX(0))
QUIT $SELECT(F="D":$PIECE(APCLX(G),U,1),1:APCLX(G))
+17 QUIT ""
+18 ;
E ;
+1 IF $PIECE(APCLVAL,U,1)>$PIECE(APCLLAST,U,1)
SET APCLLAST=APCLVAL
+2 QUIT
+3 ;
LASTDEPS(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - return last depression screen
+1 ; Return the last recorded depression screening value:
+2 ; - V Exam 36 or Behavioral Health Module Depression Screening
+3 ; - Diagnosis - V POV V79.0
+4 ; - Education Topics - V EDUCATION or Behavioral Health Module
+5 ; DEP-SCR
+6 ; - V Measurement PHQ2, PHQ9, PHQT
+7 ; - Behavioral Health Module Diagnosis (POV) of 14.1
+8 ; - Diagnosis in BGP MOOD DISORDERS taxonomy in V POV
+9 ; - Diagnosis in BGP MOOD DISORDERS taxonomy in BH
+10 ; - Problem Code of 14 or 15 in BH
+11 ; - V POV snomed PXRM BQI DEPRESSION SCREENING
+12 ;
+13 ; Input:
+14 ; APCLPDFN - Patient DFN
+15 ; APCLBD - beginning date to begin search for value - if blank, default is DOB
+16 ; APCLED - ending date of search - if blank, default is DT
+17 ; APCLFORM - APCLFORM returned: D - return date only - example 3070801
+18 ; A - return value:
+19 ; date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
+20 ; Default if blank is D
+21 ; Output:
+22 ; If APCLFORM is blank or APCLFORM is D returns internal fileman date if one found otherwise returns null
+23 ; If APCLFORM is A returns the string:
+24 ; date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
+25 ;
+26 IF $GET(APCLBD)=""
SET APCLBD=$$DOB^AUPNPAT(APCLPDFN)
+27 IF $GET(APCLED)=""
SET APCLED=DT
+28 IF $GET(APCLFORM)=""
SET APCLFORM="D"
+29 NEW APCLLAST,APCLVAL,APCLX
+30 SET APCLLAST=""
+31 SET APCLVAL=$$LASTDEP(APCLPDFN,APCLBD,APCLED,"A")
+32 DO E
+33 SET APCLVAL=$$LASTDXT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"BGP DEPRESSION SCRN DXS","A")
+34 DO E
+35 SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"PHQ2","MEASUREMENT",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")
+36 DO E
+37 SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"PHQ9","MEASUREMENT",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")
+38 DO E
+39 SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"PHQT","MEASUREMENT",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")
+40 DO E
+41 SET APCLVAL=$$LASTCPTT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"BGP DEPRESSION SCREEN CPTS","A")
+42 DO E
+43 SET APCLX=0
FOR
SET APCLX=$ORDER(^AUTTEDT("C","DEP-SCR",APCLX))
IF APCLX'=+APCLX
QUIT
Begin DoDot:1
+44 SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"`"_APCLX,"EDUCATION",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")
+45 DO E
End DoDot:1
+46 SET APCLVAL=$$SNOMEDPV^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"PXRM BQI DEPRESSION SCREENING","A")
+47 DO E
+48 SET APCLVAL=$$LASTBHDX^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"14.1","A")
+49 DO E
+50 SET APCLVAL=$$LASTBHED^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"DEP-SCR","A")
+51 DO E
+52 ;now check for mood disorders
+53 SET APCLVAL=$$LASTDXT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"BGP MOOD DISORDERS","A")
+54 DO E
+55 SET APCLVAL=$$LASTBHDT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"BGP MOOD DISORDERS","A")
+56 DO E
+57 SET APCLVAL=$$LASTBHDX^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"14","A")
+58 DO E
+59 SET APCLVAL=$$LASTBHDX^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"15","A")
+60 DO E
+61 SET APCLVAL=$$LASTBHME^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"PHQ2","A")
+62 DO E
+63 SET APCLVAL=$$LASTBHME^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"PHQ9","A")
+64 DO E
+65 SET APCLVAL=$$LASTBHME^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"PHQT","A")
+66 DO E
+67 IF APCLFORM="D"
QUIT $PIECE(APCLLAST,U)
+68 QUIT APCLLAST
+69 ;
LASTDEP(P,BD,ED,F) ;
+1 NEW %,E,D,V,X,G
+2 NEW APCLG,APCLX,APCLC,APCLV
+3 SET %=P_"^LAST EXAM 36;DURING "_BD_"-"_ED
SET E=$$START1^APCLDF(%,"APCLG(")
+4 IF $DATA(APCLG(1))
SET APCLX(9999999-$PIECE(APCLG(1),U))=$$VE(APCLG(1))
+5 ;now look at AMHREC
+6 SET APCLC=0
SET APCLV=""
+7 SET E=(9999999-BD)
SET D=9999999-ED-1_".99"
FOR
SET D=$ORDER(^AMHREC("AE",P,D))
IF D'=+D!(APCLC)!($PIECE(D,".")>E)
QUIT
SET V=0
FOR
SET V=$ORDER(^AMHREC("AE",P,D,V))
IF V'=+V!(APCLC)
QUIT
Begin DoDot:1
+8 SET X=$PIECE($GET(^AMHREC(V,14)),U,5)
+9 ;no test
IF X=""
QUIT
+10 ;don't count refusal here
IF $EXTRACT(X)="U"
QUIT
+11 IF X="REF"
QUIT
+12 SET G=9999999-$PIECE(D,".")
+13 IF $DATA(APCLX($PIECE(D,".")))
QUIT
+14 SET APCLX($PIECE(D,"."))=G_"^BH: DEPRESSION SCREENING^"_$$VAL^XBDIQ1(9002011,V,1405)_"^^9002011^"_V
End DoDot:1
+15 IF $ORDER(APCLX(0))
SET G=$ORDER(APCLX(0))
QUIT $SELECT(F="D":$PIECE(APCLX(G),U,1),1:APCLX(G))
+16 QUIT ""
+17 ;
LASTIPVS(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last ipv screen
+1 ; - V Exam 34 or Behavioral Health IPV Screening
+2 ;
+3 ; Input:
+4 ; APCLPDFN - Patient DFN
+5 ; APCLBD - beginning date to begin search for value - if blank, default is DOB
+6 ; APCLED - ending date of search - if blank, default is DT
+7 ; APCLFORM - APCLFORM returned: D - return date only - example 3070801
+8 ; A - return value:
+9 ; date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
+10 ; Default if blank is D
+11 ; Output:
+12 ; If APCLFORM is blank or APCLFORM is D returns internal fileman date if one found otherwise returns null
+13 ; If APCLFORM is A returns the string:
+14 ; date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
+15 ;
+16 IF $GET(APCLPDFN)=""
QUIT ""
+17 IF $GET(APCLBD)=""
SET APCLBD=$$DOB^AUPNPAT(APCLPDFN)
+18 IF $GET(APCLED)=""
SET APCLED=DT
+19 IF $GET(APCLFORM)=""
SET APCLFORM="D"
+20 NEW APCLLAST,APCLVAL,APCLX
+21 SET APCLLAST=""
+22 SET APCLVAL=$$LASTIPV(APCLPDFN,APCLBD,APCLED,"A")
+23 DO E
+24 IF APCLFORM="D"
QUIT $PIECE(APCLLAST,U)
+25 QUIT APCLLAST
+26 ;
LASTIPV(P,BD,ED,APCLF) ;
+1 NEW %,E,D,V,X,G
+2 NEW APCLG,APCLX,APCLC,APCLV
+3 SET %=P_"^LAST EXAM 34;DURING "_BD_"-"_ED
SET E=$$START1^APCLDF(%,"APCLG(")
+4 IF $DATA(APCLG(1))
SET APCLX(9999999-$PIECE(APCLG(1),U))=$$VE(APCLG(1))
+5 ;now look at AMHREC field
+6 SET APCLC=0
SET APCLV=""
+7 SET E=(9999999-BD)
SET D=9999999-ED-1_".99"
FOR
SET D=$ORDER(^AMHREC("AE",P,D))
IF D'=+D!(APCLC)!($PIECE(D,".")>E)
QUIT
SET V=0
FOR
SET V=$ORDER(^AMHREC("AE",P,D,V))
IF V'=+V!(APCLC)
QUIT
Begin DoDot:1
+8 SET X=$PIECE($GET(^AMHREC(V,14)),U,1)
+9 IF X=""
QUIT
+10 ;don't count refusal here
IF $EXTRACT(X)="U"
QUIT
+11 IF X="REF"
QUIT
+12 SET G=9999999-$PIECE(D,".")
+13 IF $DATA(APCLX($PIECE(D,".")))
QUIT
+14 SET APCLX($PIECE(D,"."))=G_"^BH: IPV SCREENING^"_$$VAL^XBDIQ1(9002011,V,1401)_"^^9002011^"_V
End DoDot:1
+15 IF $ORDER(APCLX(0))
SET G=$ORDER(APCLX(0))
QUIT $SELECT(APCLFORM="D":$PIECE(APCLX(G),U,1),1:APCLX(G))
+16 QUIT ""
+17 ;
LASTCOLO(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - return last Colonoscopy
+1 ; - V Procedure: 45.43, 45.22, 45.23, 45.25
+2 ; - V CPT : BGP COLO CPTS taxonomy
+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,E,%,T
+22 SET APCLVAL=""
SET APCLLAST=""
+23 SET APCLVAL=$$LASTPRCT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"BGP COLO PROCS","A")
+24 DO E
+25 SET APCLVAL=$$LASTCPTT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"BGP COLO CPTS","A")
+26 DO E
+27 IF APCLFORM="D"
QUIT $PIECE(APCLLAST,U)
+28 QUIT APCLLAST
+29 ;
LASTFSIG(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - return last sigmoidoscopy
+1 ; - V Procedure: 45.24, 45.42
+2 ; - V CPT : BGP SIG CPTS taxonomy
+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,E,%,T
+22 SET APCLVAL=""
SET APCLLAST=""
+23 SET APCLVAL=$$LASTPRCT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"BGP SIG PROCS","A")
+24 DO E
+25 SET APCLVAL=$$LASTCPTT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"BGP SIG CPTS","A")
+26 DO E
+27 IF APCLFORM="D"
QUIT $PIECE(APCLLAST,U)
+28 QUIT APCLLAST
+29 ;
REMDEPS(P,APCLBD,APCLED) ;PEP - called from reminders to get data on last depression screening exam
+1 ; Input:
+2 ; APCLPDFN - Patient DFN
+3 ; APCLBD - beginning date to begin search for value - if blank, default is DOB
+4 ; APCLED - ending date of search - if blank, default is DT
+5 ;
+6 ; Output:
+7 ;returns the string:
+8 ; 1 or 0^date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
+9 ; piece 1: 1 if item found, 0 if no depression screening found in the date range
+10 ; 2: date of last depression screening
+11 ; 3: text of item found
+12 ; 4: value - result
+13 ; 5: visit ien on which item found
+14 ; 6: file item found in (usually a V File #)
+15 ; 7: ien of V File entry found
+16 ;
+17 IF '$GET(P)
QUIT 0
+18 IF $GET(APCLBD)=""
SET APCLBD=$$DOB^AUPNPAT(P)
+19 IF $GET(APCLED)=""
SET APCLED=DT
+20 NEW APCLR
+21 SET APCLR=$$LASTDEPS(P,APCLBD,APCLED,"A")
+22 IF APCLR]""
QUIT 1_"^"_APCLR
+23 QUIT 0
