APCLAPI6 ; IHS/CMI/LAB - visit data ;
;;2.0;IHS PCC SUITE;**5**;MAY 14, 2009
;IHS/TUCSON/LAB - added G parameter to provider call
;
;
;
LASTPLR(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last PROBLEM LIST REVIEWED
; Return the last recorded PROBLEM LIST REVIEWED FROM V UPDATED/REVIEWED:
; .04 OF V UPDATED/REVIEWED is set to 1
;
; 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^provider who documented^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^PROVIDER^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,D,G,ED,BD
S BD=9999999-APCLBD
S ED=9999999-APCLED
S APCLLAST=""
S V=$O(^AUTTCRA("C","PLR",0))
I 'V Q ""
S D=ED-1,D=D_".999999" F S D=$O(^AUPNVRUP("AA",APCLPDFN,V,D)) Q:D'=+D!($P(D,".")>BD) D
.S X=0 F S X=$O(^AUPNVRUP("AA",APCLPDFN,V,D,X)) Q:X'=+X D
..Q:'$D(^AUPNVRUP(X,0))
..Q:$P($G(^AUPNVRUP(X,2)),U,1)
..S APCLVAL=$P($P(^AUPNVRUP(X,12),U),".")_U_$$VAL^XBDIQ1(9000010.54,X,.01)_U_$P($G(^AUPNVRUP(X,12)),U,4)_U_$P(^AUPNVRUP(X,0),U,3)_U_9000010.54_U_X
..D E
I APCLFORM="D" Q $P(APCLLAST,U)
Q APCLLAST
;
E ;
I $P(APCLVAL,U,1)'<$P(APCLLAST,U,1) S APCLLAST=APCLVAL
Q
LASTPLU(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last PROBLEM LIST UPDATE
; Return the last recorded PROBLEM LIST UPDATED FROM V UPDATED/REVIEWED:
; .11 OF V UPDATED/REVIEWED is set to 1
;
; 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^provider who documented^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^PROVIDER^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,D,G,ED,BD
S BD=9999999-APCLBD
S ED=9999999-APCLED
S APCLLAST=""
S V=$O(^AUTTCRA("C","PLU",0))
I 'V Q ""
S D=ED-1,D=D_".999999" F S D=$O(^AUPNVRUP("AA",APCLPDFN,V,D)) Q:D'=+D!($P(D,".")>BD) D
.S X=0 F S X=$O(^AUPNVRUP("AA",APCLPDFN,V,D,X)) Q:X'=+X D
..Q:'$D(^AUPNVRUP(X,0))
..Q:$P($G(^AUPNVRUP(X,2)),U,1)
..S APCLVAL=$P($P(^AUPNVRUP(X,12),U),".")_U_$$VAL^XBDIQ1(9000010.54,X,.01)_U_$P($G(^AUPNVRUP(X,12)),U,4)_U_$P(^AUPNVRUP(X,0),U,3)_U_9000010.54_U_X
..D E
I APCLFORM="D" Q $P(APCLLAST,U)
Q APCLLAST
;
LASTNAP(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last NO ACTIVE PROBLEMS
; Return the last recorded NO ACTIVE PROBLEMS FROM V UPDATED/REVIEWED:
; .09 OF V UPDATED/REVIEWED is set to 1
;
; 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^provider who documented^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^PROVIDER^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,D,G,ED,BD
S BD=9999999-APCLBD
S ED=9999999-APCLED
S APCLLAST=""
S V=$O(^AUTTCRA("C","NAP",0))
I 'V Q ""
S D=ED-1,D=D_".999999" F S D=$O(^AUPNVRUP("AA",APCLPDFN,V,D)) Q:D'=+D!($P(D,".")>BD) D
.S X=0 F S X=$O(^AUPNVRUP("AA",APCLPDFN,V,D,X)) Q:X'=+X D
..Q:'$D(^AUPNVRUP(X,0))
..Q:$P($G(^AUPNVRUP(X,2)),U,1)
..S APCLVAL=$P($P(^AUPNVRUP(X,12),U),".")_U_$$VAL^XBDIQ1(9000010.54,X,.01)_U_$P($G(^AUPNVRUP(X,12)),U,4)_U_$P(^AUPNVRUP(X,0),U,3)_U_9000010.54_U_X
..D E
I APCLFORM="D" Q $P(APCLLAST,U)
Q APCLLAST
UPREV(V,I) ;EP - IS UPDATE/REVIEWED I ON VISIT V?
I '$G(V) Q ""
I $G(I)="" Q ""
NEW X,Y,Z
S Z=0
S Y=$O(^AUTTCRA("C",I,0))
I Y="" Q ""
S X=0 F S X=$O(^AUPNVRUP("AD",V,X)) Q:X'=+X D
.Q:$P($G(^AUPNVRUP(X,2)),U,1) ;error
.Q:'$D(^AUPNVRUP(X,0))
.Q:$P(^AUPNVRUP(X,0),U,1)'=Y
.S Z=1
Q Z
PRREV ;EP = set
NEW X,Y,Z
S Z=0
S Y=$O(^AUTTCRA("C",APCLVAL,0))
I Y="" Q ""
S X=0 F S X=$O(^AUPNVRUP("AD",APCLVIEN,X)) Q:X'=+X D
.Q:$P($G(^AUPNVRUP(X,2)),U,1) ;error
.Q:'$D(^AUPNVRUP(X,0))
.Q:$P(^AUPNVRUP(X,0),U,1)'=Y
.S APCLPCNT=APCLPCNT+1,APCLPRNM(APCLPCNT)=$$VAL^XBDIQ1(9000010.54,X,.01)
.Q
Q
UPREVP ;EP - IS UPDATE/REVIEWED I ON VISIT V?
NEW Y,Z
S Z=0
S Y=$O(^AUTTCRA("C",APCLVAL,0))
I Y="" Q ""
S X=0 F S X=$O(^AUPNVRUP("AD",APCLVIEN,X)) Q:X'=+X D
.Q:$P($G(^AUPNVRUP(X,2)),U,1) ;error
.Q:'$D(^AUPNVRUP(X,0))
.Q:$P(^AUPNVRUP(X,0),U,1)'=Y
.S Z=$P($G(^AUPNVRUP(X,12)),U,4) I Z S X(Z)=""
Q
UPREVPP ;EP = set
NEW X,Y,Z
S Z=0
S Y=$O(^AUTTCRA("C",APCLVAL,0))
I Y="" Q ""
S X=0 F S X=$O(^AUPNVRUP("AD",APCLVIEN,X)) Q:X'=+X D
.Q:$P($G(^AUPNVRUP(X,2)),U,1) ;error
.Q:'$D(^AUPNVRUP(X,0))
.Q:$P(^AUPNVRUP(X,0),U,1)'=Y
.Q:$P($G(^AUPNVRUP(X,12)),U,4)=""
.S APCLPCNT=APCLPCNT+1,APCLPRNM(APCLPCNT)=$$VAL^XBDIQ1(9000010.54,X,1204)
.Q
Q
;
LASTALR(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last ALLERGY LIST REVIEWED
; Return the last recorded ALLERGY LIST REVIEWED FROM V UPDATED/REVIEWED:
; .04 OF V UPDATED/REVIEWED is set to 1
;
; 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^provider who documented^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^PROVIDER^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,D,G,ED,BD
S BD=9999999-APCLBD
S ED=9999999-APCLED
S APCLLAST=""
S V=$O(^AUTTCRA("C","ALR",0))
I 'V Q ""
S D=ED-1,D=D_".999999" F S D=$O(^AUPNVRUP("AA",APCLPDFN,V,D)) Q:D'=+D!($P(D,".")>BD) D
.S X=0 F S X=$O(^AUPNVRUP("AA",APCLPDFN,V,D,X)) Q:X'=+X D
..Q:'$D(^AUPNVRUP(X,0))
..Q:$P($G(^AUPNVRUP(X,2)),U,1)
..S APCLVAL=$P($P(^AUPNVRUP(X,12),U),".")_U_$$VAL^XBDIQ1(9000010.54,X,.01)_U_$P($G(^AUPNVRUP(X,12)),U,4)_U_$P(^AUPNVRUP(X,0),U,3)_U_9000010.54_U_X
..D E
I APCLFORM="D" Q $P(APCLLAST,U)
Q APCLLAST
;
LASTMLR(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last MEDICATION LIST REVIEWED
; Return the last recorded MEDICATION LIST REVIEWED FROM V UPDATED/REVIEWED:
; .04 OF V UPDATED/REVIEWED is set to 1
;
; 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^provider who documented^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^PROVIDER^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,D,G,ED,BD
S BD=9999999-APCLBD
S ED=9999999-APCLED
S APCLLAST=""
S V=$O(^AUTTCRA("C","MLR",0))
I 'V Q ""
S D=ED-1,D=D_".999999" F S D=$O(^AUPNVRUP("AA",APCLPDFN,V,D)) Q:D'=+D!($P(D,".")>BD) D
.S X=0 F S X=$O(^AUPNVRUP("AA",APCLPDFN,V,D,X)) Q:X'=+X D
..Q:'$D(^AUPNVRUP(X,0))
..Q:$P($G(^AUPNVRUP(X,2)),U,1)
..S APCLVAL=$P($P(^AUPNVRUP(X,12),U),".")_U_$$VAL^XBDIQ1(9000010.54,X,.01)_U_$P($G(^AUPNVRUP(X,12)),U,4)_U_$P(^AUPNVRUP(X,0),U,3)_U_9000010.54_U_X
..D E
I APCLFORM="D" Q $P(APCLLAST,U)
Q APCLLAST
LASTMLU(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last PROBLEM LIST UPDATE
; Return the last recorded PROBLEM LIST UPDATED FROM V UPDATED/REVIEWED:
; .11 OF V UPDATED/REVIEWED is set to 1
;
; 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^provider who documented^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^PROVIDER^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,D,G,ED,BD
S BD=9999999-APCLBD
S ED=9999999-APCLED
S APCLLAST=""
S V=$O(^AUTTCRA("C","MLU",0))
I 'V Q ""
S D=ED-1,D=D_".999999" F S D=$O(^AUPNVRUP("AA",APCLPDFN,V,D)) Q:D'=+D!($P(D,".")>BD) D
.S X=0 F S X=$O(^AUPNVRUP("AA",APCLPDFN,V,D,X)) Q:X'=+X D
..Q:'$D(^AUPNVRUP(X,0))
..Q:$P($G(^AUPNVRUP(X,2)),U,1)
..S APCLVAL=$P($P(^AUPNVRUP(X,12),U),".")_U_$$VAL^XBDIQ1(9000010.54,X,.01)_U_$P($G(^AUPNVRUP(X,12)),U,4)_U_$P(^AUPNVRUP(X,0),U,3)_U_9000010.54_U_X
..D E
I APCLFORM="D" Q $P(APCLLAST,U)
Q APCLLAST
;
LASTNAM(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last NO ACTIVE PROBLEMS
; Return the last recorded NO ACTIVE PROBLEMS FROM V UPDATED/REVIEWED:
; .09 OF V UPDATED/REVIEWED is set to 1
;
; 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^provider who documented^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^PROVIDER^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,D,G,ED,BD
S BD=9999999-APCLBD
S ED=9999999-APCLED
S APCLLAST=""
S V=$O(^AUTTCRA("C","NAM",0))
I 'V Q ""
S D=ED-1,D=D_".999999" F S D=$O(^AUPNVRUP("AA",APCLPDFN,V,D)) Q:D'=+D!($P(D,".")>BD) D
.S X=0 F S X=$O(^AUPNVRUP("AA",APCLPDFN,V,D,X)) Q:X'=+X D
..Q:'$D(^AUPNVRUP(X,0))
..Q:$P($G(^AUPNVRUP(X,2)),U,1)
..S APCLVAL=$P($P(^AUPNVRUP(X,12),U),".")_U_$$VAL^XBDIQ1(9000010.54,X,.01)_U_$P($G(^AUPNVRUP(X,12)),U,4)_U_$P(^AUPNVRUP(X,0),U,3)_U_9000010.54_U_X
..D E
I APCLFORM="D" Q $P(APCLLAST,U)
Q APCLLAST
;
LASTALU(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last ALLERGY UPDATE
; Return the last recorded ALLERGY UPDATED FROM V UPDATED/REVIEWED:
; .11 OF V UPDATED/REVIEWED is set to 1
;
; 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^provider who documented^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^PROVIDER^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,D,G,ED,BD
S BD=9999999-APCLBD
S ED=9999999-APCLED
S APCLLAST=""
S V=$O(^AUTTCRA("C","ALU",0))
I 'V Q ""
S D=ED-1,D=D_".999999" F S D=$O(^AUPNVRUP("AA",APCLPDFN,V,D)) Q:D'=+D!($P(D,".")>BD) D
.S X=0 F S X=$O(^AUPNVRUP("AA",APCLPDFN,V,D,X)) Q:X'=+X D
..Q:'$D(^AUPNVRUP(X,0))
..Q:$P($G(^AUPNVRUP(X,2)),U,1)
..S APCLVAL=$P($P(^AUPNVRUP(X,12),U),".")_U_$$VAL^XBDIQ1(9000010.54,X,.01)_U_$P($G(^AUPNVRUP(X,12)),U,4)_U_$P(^AUPNVRUP(X,0),U,3)_U_9000010.54_U_X
..D E
I APCLFORM="D" Q $P(APCLLAST,U)
Q APCLLAST
;
LASTNAA(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last NO ACTIVE ALLERGIES
G LASTNAA^APCLAPI7
APCLAPI6 ; IHS/CMI/LAB - visit data ;
+1 ;;2.0;IHS PCC SUITE;**5**;MAY 14, 2009
+2 ;IHS/TUCSON/LAB - added G parameter to provider call
+3 ;
+4 ;
+5 ;
LASTPLR(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last PROBLEM LIST REVIEWED
+1 ; Return the last recorded PROBLEM LIST REVIEWED FROM V UPDATED/REVIEWED:
+2 ; .04 OF V UPDATED/REVIEWED is set to 1
+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^provider who documented^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^PROVIDER^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,D,G,ED,BD
+22 SET BD=9999999-APCLBD
+23 SET ED=9999999-APCLED
+24 SET APCLLAST=""
+25 SET V=$ORDER(^AUTTCRA("C","PLR",0))
+26 IF 'V
QUIT ""
+27 SET D=ED-1
SET D=D_".999999"
FOR
SET D=$ORDER(^AUPNVRUP("AA",APCLPDFN,V,D))
IF D'=+D!($PIECE(D,".")>BD)
QUIT
Begin DoDot:1
+28 SET X=0
FOR
SET X=$ORDER(^AUPNVRUP("AA",APCLPDFN,V,D,X))
IF X'=+X
QUIT
Begin DoDot:2
+29 IF '$DATA(^AUPNVRUP(X,0))
QUIT
+30 IF $PIECE($GET(^AUPNVRUP(X,2)),U,1)
QUIT
+31 SET APCLVAL=$PIECE($PIECE(^AUPNVRUP(X,12),U),".")_U_$$VAL^XBDIQ1(9000010.54,X,.01)_U_$PIECE($GET(^AUPNVRUP(X,12)),U,4)_U_$PIECE(^AUPNVRUP(X,0),U,3)_U_9000010.54_U_X
+32 DO E
End DoDot:2
End DoDot:1
+33 IF APCLFORM="D"
QUIT $PIECE(APCLLAST,U)
+34 QUIT APCLLAST
+35 ;
E ;
+1 IF $PIECE(APCLVAL,U,1)'<$PIECE(APCLLAST,U,1)
SET APCLLAST=APCLVAL
+2 QUIT
LASTPLU(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last PROBLEM LIST UPDATE
+1 ; Return the last recorded PROBLEM LIST UPDATED FROM V UPDATED/REVIEWED:
+2 ; .11 OF V UPDATED/REVIEWED is set to 1
+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^provider who documented^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^PROVIDER^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,D,G,ED,BD
+22 SET BD=9999999-APCLBD
+23 SET ED=9999999-APCLED
+24 SET APCLLAST=""
+25 SET V=$ORDER(^AUTTCRA("C","PLU",0))
+26 IF 'V
QUIT ""
+27 SET D=ED-1
SET D=D_".999999"
FOR
SET D=$ORDER(^AUPNVRUP("AA",APCLPDFN,V,D))
IF D'=+D!($PIECE(D,".")>BD)
QUIT
Begin DoDot:1
+28 SET X=0
FOR
SET X=$ORDER(^AUPNVRUP("AA",APCLPDFN,V,D,X))
IF X'=+X
QUIT
Begin DoDot:2
+29 IF '$DATA(^AUPNVRUP(X,0))
QUIT
+30 IF $PIECE($GET(^AUPNVRUP(X,2)),U,1)
QUIT
+31 SET APCLVAL=$PIECE($PIECE(^AUPNVRUP(X,12),U),".")_U_$$VAL^XBDIQ1(9000010.54,X,.01)_U_$PIECE($GET(^AUPNVRUP(X,12)),U,4)_U_$PIECE(^AUPNVRUP(X,0),U,3)_U_9000010.54_U_X
+32 DO E
End DoDot:2
End DoDot:1
+33 IF APCLFORM="D"
QUIT $PIECE(APCLLAST,U)
+34 QUIT APCLLAST
+35 ;
LASTNAP(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last NO ACTIVE PROBLEMS
+1 ; Return the last recorded NO ACTIVE PROBLEMS FROM V UPDATED/REVIEWED:
+2 ; .09 OF V UPDATED/REVIEWED is set to 1
+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^provider who documented^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^PROVIDER^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,D,G,ED,BD
+22 SET BD=9999999-APCLBD
+23 SET ED=9999999-APCLED
+24 SET APCLLAST=""
+25 SET V=$ORDER(^AUTTCRA("C","NAP",0))
+26 IF 'V
QUIT ""
+27 SET D=ED-1
SET D=D_".999999"
FOR
SET D=$ORDER(^AUPNVRUP("AA",APCLPDFN,V,D))
IF D'=+D!($PIECE(D,".")>BD)
QUIT
Begin DoDot:1
+28 SET X=0
FOR
SET X=$ORDER(^AUPNVRUP("AA",APCLPDFN,V,D,X))
IF X'=+X
QUIT
Begin DoDot:2
+29 IF '$DATA(^AUPNVRUP(X,0))
QUIT
+30 IF $PIECE($GET(^AUPNVRUP(X,2)),U,1)
QUIT
+31 SET APCLVAL=$PIECE($PIECE(^AUPNVRUP(X,12),U),".")_U_$$VAL^XBDIQ1(9000010.54,X,.01)_U_$PIECE($GET(^AUPNVRUP(X,12)),U,4)_U_$PIECE(^AUPNVRUP(X,0),U,3)_U_9000010.54_U_X
+32 DO E
End DoDot:2
End DoDot:1
+33 IF APCLFORM="D"
QUIT $PIECE(APCLLAST,U)
+34 QUIT APCLLAST
UPREV(V,I) ;EP - IS UPDATE/REVIEWED I ON VISIT V?
+1 IF '$GET(V)
QUIT ""
+2 IF $GET(I)=""
QUIT ""
+3 NEW X,Y,Z
+4 SET Z=0
+5 SET Y=$ORDER(^AUTTCRA("C",I,0))
+6 IF Y=""
QUIT ""
+7 SET X=0
FOR
SET X=$ORDER(^AUPNVRUP("AD",V,X))
IF X'=+X
QUIT
Begin DoDot:1
+8 ;error
IF $PIECE($GET(^AUPNVRUP(X,2)),U,1)
QUIT
+9 IF '$DATA(^AUPNVRUP(X,0))
QUIT
+10 IF $PIECE(^AUPNVRUP(X,0),U,1)'=Y
QUIT
+11 SET Z=1
End DoDot:1
+12 QUIT Z
PRREV ;EP = set
+1 NEW X,Y,Z
+2 SET Z=0
+3 SET Y=$ORDER(^AUTTCRA("C",APCLVAL,0))
+4 IF Y=""
QUIT ""
+5 SET X=0
FOR
SET X=$ORDER(^AUPNVRUP("AD",APCLVIEN,X))
IF X'=+X
QUIT
Begin DoDot:1
+6 ;error
IF $PIECE($GET(^AUPNVRUP(X,2)),U,1)
QUIT
+7 IF '$DATA(^AUPNVRUP(X,0))
QUIT
+8 IF $PIECE(^AUPNVRUP(X,0),U,1)'=Y
QUIT
+9 SET APCLPCNT=APCLPCNT+1
SET APCLPRNM(APCLPCNT)=$$VAL^XBDIQ1(9000010.54,X,.01)
+10 QUIT
End DoDot:1
+11 QUIT
UPREVP ;EP - IS UPDATE/REVIEWED I ON VISIT V?
+1 NEW Y,Z
+2 SET Z=0
+3 SET Y=$ORDER(^AUTTCRA("C",APCLVAL,0))
+4 IF Y=""
QUIT ""
+5 SET X=0
FOR
SET X=$ORDER(^AUPNVRUP("AD",APCLVIEN,X))
IF X'=+X
QUIT
Begin DoDot:1
+6 ;error
IF $PIECE($GET(^AUPNVRUP(X,2)),U,1)
QUIT
+7 IF '$DATA(^AUPNVRUP(X,0))
QUIT
+8 IF $PIECE(^AUPNVRUP(X,0),U,1)'=Y
QUIT
+9 SET Z=$PIECE($GET(^AUPNVRUP(X,12)),U,4)
IF Z
SET X(Z)=""
End DoDot:1
+10 QUIT
UPREVPP ;EP = set
+1 NEW X,Y,Z
+2 SET Z=0
+3 SET Y=$ORDER(^AUTTCRA("C",APCLVAL,0))
+4 IF Y=""
QUIT ""
+5 SET X=0
FOR
SET X=$ORDER(^AUPNVRUP("AD",APCLVIEN,X))
IF X'=+X
QUIT
Begin DoDot:1
+6 ;error
IF $PIECE($GET(^AUPNVRUP(X,2)),U,1)
QUIT
+7 IF '$DATA(^AUPNVRUP(X,0))
QUIT
+8 IF $PIECE(^AUPNVRUP(X,0),U,1)'=Y
QUIT
+9 IF $PIECE($GET(^AUPNVRUP(X,12)),U,4)=""
QUIT
+10 SET APCLPCNT=APCLPCNT+1
SET APCLPRNM(APCLPCNT)=$$VAL^XBDIQ1(9000010.54,X,1204)
+11 QUIT
End DoDot:1
+12 QUIT
+13 ;
LASTALR(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last ALLERGY LIST REVIEWED
+1 ; Return the last recorded ALLERGY LIST REVIEWED FROM V UPDATED/REVIEWED:
+2 ; .04 OF V UPDATED/REVIEWED is set to 1
+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^provider who documented^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^PROVIDER^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,D,G,ED,BD
+22 SET BD=9999999-APCLBD
+23 SET ED=9999999-APCLED
+24 SET APCLLAST=""
+25 SET V=$ORDER(^AUTTCRA("C","ALR",0))
+26 IF 'V
QUIT ""
+27 SET D=ED-1
SET D=D_".999999"
FOR
SET D=$ORDER(^AUPNVRUP("AA",APCLPDFN,V,D))
IF D'=+D!($PIECE(D,".")>BD)
QUIT
Begin DoDot:1
+28 SET X=0
FOR
SET X=$ORDER(^AUPNVRUP("AA",APCLPDFN,V,D,X))
IF X'=+X
QUIT
Begin DoDot:2
+29 IF '$DATA(^AUPNVRUP(X,0))
QUIT
+30 IF $PIECE($GET(^AUPNVRUP(X,2)),U,1)
QUIT
+31 SET APCLVAL=$PIECE($PIECE(^AUPNVRUP(X,12),U),".")_U_$$VAL^XBDIQ1(9000010.54,X,.01)_U_$PIECE($GET(^AUPNVRUP(X,12)),U,4)_U_$PIECE(^AUPNVRUP(X,0),U,3)_U_9000010.54_U_X
+32 DO E
End DoDot:2
End DoDot:1
+33 IF APCLFORM="D"
QUIT $PIECE(APCLLAST,U)
+34 QUIT APCLLAST
+35 ;
LASTMLR(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last MEDICATION LIST REVIEWED
+1 ; Return the last recorded MEDICATION LIST REVIEWED FROM V UPDATED/REVIEWED:
+2 ; .04 OF V UPDATED/REVIEWED is set to 1
+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^provider who documented^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^PROVIDER^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,D,G,ED,BD
+22 SET BD=9999999-APCLBD
+23 SET ED=9999999-APCLED
+24 SET APCLLAST=""
+25 SET V=$ORDER(^AUTTCRA("C","MLR",0))
+26 IF 'V
QUIT ""
+27 SET D=ED-1
SET D=D_".999999"
FOR
SET D=$ORDER(^AUPNVRUP("AA",APCLPDFN,V,D))
IF D'=+D!($PIECE(D,".")>BD)
QUIT
Begin DoDot:1
+28 SET X=0
FOR
SET X=$ORDER(^AUPNVRUP("AA",APCLPDFN,V,D,X))
IF X'=+X
QUIT
Begin DoDot:2
+29 IF '$DATA(^AUPNVRUP(X,0))
QUIT
+30 IF $PIECE($GET(^AUPNVRUP(X,2)),U,1)
QUIT
+31 SET APCLVAL=$PIECE($PIECE(^AUPNVRUP(X,12),U),".")_U_$$VAL^XBDIQ1(9000010.54,X,.01)_U_$PIECE($GET(^AUPNVRUP(X,12)),U,4)_U_$PIECE(^AUPNVRUP(X,0),U,3)_U_9000010.54_U_X
+32 DO E
End DoDot:2
End DoDot:1
+33 IF APCLFORM="D"
QUIT $PIECE(APCLLAST,U)
+34 QUIT APCLLAST
LASTMLU(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last PROBLEM LIST UPDATE
+1 ; Return the last recorded PROBLEM LIST UPDATED FROM V UPDATED/REVIEWED:
+2 ; .11 OF V UPDATED/REVIEWED is set to 1
+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^provider who documented^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^PROVIDER^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,D,G,ED,BD
+22 SET BD=9999999-APCLBD
+23 SET ED=9999999-APCLED
+24 SET APCLLAST=""
+25 SET V=$ORDER(^AUTTCRA("C","MLU",0))
+26 IF 'V
QUIT ""
+27 SET D=ED-1
SET D=D_".999999"
FOR
SET D=$ORDER(^AUPNVRUP("AA",APCLPDFN,V,D))
IF D'=+D!($PIECE(D,".")>BD)
QUIT
Begin DoDot:1
+28 SET X=0
FOR
SET X=$ORDER(^AUPNVRUP("AA",APCLPDFN,V,D,X))
IF X'=+X
QUIT
Begin DoDot:2
+29 IF '$DATA(^AUPNVRUP(X,0))
QUIT
+30 IF $PIECE($GET(^AUPNVRUP(X,2)),U,1)
QUIT
+31 SET APCLVAL=$PIECE($PIECE(^AUPNVRUP(X,12),U),".")_U_$$VAL^XBDIQ1(9000010.54,X,.01)_U_$PIECE($GET(^AUPNVRUP(X,12)),U,4)_U_$PIECE(^AUPNVRUP(X,0),U,3)_U_9000010.54_U_X
+32 DO E
End DoDot:2
End DoDot:1
+33 IF APCLFORM="D"
QUIT $PIECE(APCLLAST,U)
+34 QUIT APCLLAST
+35 ;
LASTNAM(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last NO ACTIVE PROBLEMS
+1 ; Return the last recorded NO ACTIVE PROBLEMS FROM V UPDATED/REVIEWED:
+2 ; .09 OF V UPDATED/REVIEWED is set to 1
+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^provider who documented^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^PROVIDER^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,D,G,ED,BD
+22 SET BD=9999999-APCLBD
+23 SET ED=9999999-APCLED
+24 SET APCLLAST=""
+25 SET V=$ORDER(^AUTTCRA("C","NAM",0))
+26 IF 'V
QUIT ""
+27 SET D=ED-1
SET D=D_".999999"
FOR
SET D=$ORDER(^AUPNVRUP("AA",APCLPDFN,V,D))
IF D'=+D!($PIECE(D,".")>BD)
QUIT
Begin DoDot:1
+28 SET X=0
FOR
SET X=$ORDER(^AUPNVRUP("AA",APCLPDFN,V,D,X))
IF X'=+X
QUIT
Begin DoDot:2
+29 IF '$DATA(^AUPNVRUP(X,0))
QUIT
+30 IF $PIECE($GET(^AUPNVRUP(X,2)),U,1)
QUIT
+31 SET APCLVAL=$PIECE($PIECE(^AUPNVRUP(X,12),U),".")_U_$$VAL^XBDIQ1(9000010.54,X,.01)_U_$PIECE($GET(^AUPNVRUP(X,12)),U,4)_U_$PIECE(^AUPNVRUP(X,0),U,3)_U_9000010.54_U_X
+32 DO E
End DoDot:2
End DoDot:1
+33 IF APCLFORM="D"
QUIT $PIECE(APCLLAST,U)
+34 QUIT APCLLAST
+35 ;
LASTALU(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last ALLERGY UPDATE
+1 ; Return the last recorded ALLERGY UPDATED FROM V UPDATED/REVIEWED:
+2 ; .11 OF V UPDATED/REVIEWED is set to 1
+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^provider who documented^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^PROVIDER^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,D,G,ED,BD
+22 SET BD=9999999-APCLBD
+23 SET ED=9999999-APCLED
+24 SET APCLLAST=""
+25 SET V=$ORDER(^AUTTCRA("C","ALU",0))
+26 IF 'V
QUIT ""
+27 SET D=ED-1
SET D=D_".999999"
FOR
SET D=$ORDER(^AUPNVRUP("AA",APCLPDFN,V,D))
IF D'=+D!($PIECE(D,".")>BD)
QUIT
Begin DoDot:1
+28 SET X=0
FOR
SET X=$ORDER(^AUPNVRUP("AA",APCLPDFN,V,D,X))
IF X'=+X
QUIT
Begin DoDot:2
+29 IF '$DATA(^AUPNVRUP(X,0))
QUIT
+30 IF $PIECE($GET(^AUPNVRUP(X,2)),U,1)
QUIT
+31 SET APCLVAL=$PIECE($PIECE(^AUPNVRUP(X,12),U),".")_U_$$VAL^XBDIQ1(9000010.54,X,.01)_U_$PIECE($GET(^AUPNVRUP(X,12)),U,4)_U_$PIECE(^AUPNVRUP(X,0),U,3)_U_9000010.54_U_X
+32 DO E
End DoDot:2
End DoDot:1
+33 IF APCLFORM="D"
QUIT $PIECE(APCLLAST,U)
+34 QUIT APCLLAST
+35 ;
LASTNAA(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last NO ACTIVE ALLERGIES
+1 GOTO LASTNAA^APCLAPI7
