AMHAPI6 ; IHS/CMI/LAB - visit data ;
;;4.0;IHS BEHAVIORAL HEALTH;**2**;JUN 18, 2010;Build 23
;IHS/TUCSON/LAB - added G parameter to provider call
;
;
;
LASTPLR(AMHPDFN,AMHBD,AMHED,AMHFORM) ;PEP - date of last PROBLEM LIST REVIEWED
; Return the last recorded PROBLEM LIST REVIEWED FROM MHSS UPDATED/REVIEWED:
; .04 OF MHSS UPDATED/REVIEWED is set to 1
;
; Input:
; AMHPDFN - Patient DFN
; AMHBD - beginning date to begin search for value - if blank, default is DOB
; AMHED - ending date of search - if blank, default is DT
; AMHFORM - AMHFORM 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 AMHFORM is blank or AMHFORM is D returns internal fileman date if one found otherwise returns null
; If AMHFORM is A returns the string:
; date^text of item found^PROVIDER^visit ien^File found in^ien of file found in
;
I $G(AMHPDFN)="" Q ""
I $G(AMHBD)="" S AMHBD=$$DOB^AUPNPAT(AMHPDFN)
I $G(AMHED)="" S AMHED=DT
I $G(AMHFORM)="" S AMHFORM="D"
NEW AMHLAST,AMHVAL,AMHX,R,X,Y,V,E,D,G,ED,BD
S BD=9999999-AMHBD
S ED=9999999-AMHED
S AMHLAST=""
S V=$O(^AUTTCRA("C","PLR",0))
I 'V Q ""
S D=ED-1,D=D_".999999" F S D=$O(^AMHRRUP("AA",AMHPDFN,V,D)) Q:D'=+D!($P(D,".")>BD) D
.S X=0 F S X=$O(^AMHRRUP("AA",AMHPDFN,V,D,X)) Q:X'=+X D
..Q:'$D(^AMHRRUP(X,0))
..Q:$P($G(^AMHRRUP(X,2)),U,1)
..S AMHVAL=$P($P(^AMHRRUP(X,12),U),".")_U_$$VAL^XBDIQ1(9000010.54,X,.01)_U_$P($G(^AMHRRUP(X,12)),U,4)_U_$P(^AMHRRUP(X,0),U,3)_U_9000010.54_U_X
..D E
I AMHFORM="D" Q $P(AMHLAST,U)
Q AMHLAST
;
E ;
I $P(AMHVAL,U,1)'<$P(AMHLAST,U,1) S AMHLAST=AMHVAL
Q
LASTPLU(AMHPDFN,AMHBD,AMHED,AMHFORM) ;PEP - date of last PROBLEM LIST UPDATE
; Return the last recorded PROBLEM LIST UPDATED FROM MHSS UPDATED/REVIEWED:
; .11 OF MHSS UPDATED/REVIEWED is set to 1
;
; Input:
; AMHPDFN - Patient DFN
; AMHBD - beginning date to begin search for value - if blank, default is DOB
; AMHED - ending date of search - if blank, default is DT
; AMHFORM - AMHFORM 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 AMHFORM is blank or AMHFORM is D returns internal fileman date if one found otherwise returns null
; If AMHFORM is A returns the string:
; date^text of item found^PROVIDER^visit ien^File found in^ien of file found in
;
I $G(AMHPDFN)="" Q ""
I $G(AMHBD)="" S AMHBD=$$DOB^AUPNPAT(AMHPDFN)
I $G(AMHED)="" S AMHED=DT
I $G(AMHFORM)="" S AMHFORM="D"
NEW AMHLAST,AMHVAL,AMHX,R,X,Y,V,E,D,G,ED,BD
S BD=9999999-AMHBD
S ED=9999999-AMHED
S AMHLAST=""
S V=$O(^AUTTCRA("C","PLU",0))
I 'V Q ""
S D=ED-1,D=D_".999999" F S D=$O(^AMHRRUP("AA",AMHPDFN,V,D)) Q:D'=+D!($P(D,".")>BD) D
.S X=0 F S X=$O(^AMHRRUP("AA",AMHPDFN,V,D,X)) Q:X'=+X D
..Q:'$D(^AMHRRUP(X,0))
..Q:$P($G(^AMHRRUP(X,2)),U,1)
..S AMHVAL=$P($P(^AMHRRUP(X,12),U),".")_U_$$VAL^XBDIQ1(9000010.54,X,.01)_U_$P($G(^AMHRRUP(X,12)),U,4)_U_$P(^AMHRRUP(X,0),U,3)_U_9000010.54_U_X
..D E
I AMHFORM="D" Q $P(AMHLAST,U)
Q AMHLAST
;
LASTNAP(AMHPDFN,AMHBD,AMHED,AMHFORM) ;PEP - date of last NO ACTIVE PROBLEMS
; Return the last recorded NO ACTIVE PROBLEMS FROM MHSS UPDATED/REVIEWED:
; .09 OF MHSS UPDATED/REVIEWED is set to 1
;
; Input:
; AMHPDFN - Patient DFN
; AMHBD - beginning date to begin search for value - if blank, default is DOB
; AMHED - ending date of search - if blank, default is DT
; AMHFORM - AMHFORM 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 AMHFORM is blank or AMHFORM is D returns internal fileman date if one found otherwise returns null
; If AMHFORM is A returns the string:
; date^text of item found^PROVIDER^visit ien^File found in^ien of file found in
;
I $G(AMHPDFN)="" Q ""
I $G(AMHBD)="" S AMHBD=$$DOB^AUPNPAT(AMHPDFN)
I $G(AMHED)="" S AMHED=DT
I $G(AMHFORM)="" S AMHFORM="D"
NEW AMHLAST,AMHVAL,AMHX,R,X,Y,V,E,D,G,ED,BD
S BD=9999999-AMHBD
S ED=9999999-AMHED
S AMHLAST=""
S V=$O(^AUTTCRA("C","NAP",0))
I 'V Q ""
S D=ED-1,D=D_".999999" F S D=$O(^AMHRRUP("AA",AMHPDFN,V,D)) Q:D'=+D!($P(D,".")>BD) D
.S X=0 F S X=$O(^AMHRRUP("AA",AMHPDFN,V,D,X)) Q:X'=+X D
..Q:'$D(^AMHRRUP(X,0))
..Q:$P($G(^AMHRRUP(X,2)),U,1)
..S AMHVAL=$P($P(^AMHRRUP(X,12),U),".")_U_$$VAL^XBDIQ1(9000010.54,X,.01)_U_$P($G(^AMHRRUP(X,12)),U,4)_U_$P(^AMHRRUP(X,0),U,3)_U_9000010.54_U_X
..D E
I AMHFORM="D" Q $P(AMHLAST,U)
Q AMHLAST
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(^AMHRRUP("AD",V,X)) Q:X'=+X D
.Q:$P($G(^AMHRRUP(X,2)),U,1) ;error
.Q:'$D(^AMHRRUP(X,0))
.Q:$P(^AMHRRUP(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",AMHVAL,0))
I Y="" Q ""
S X=0 F S X=$O(^AMHRRUP("AD",AMHVIEN,X)) Q:X'=+X D
.Q:$P($G(^AMHRRUP(X,2)),U,1) ;error
.Q:'$D(^AMHRRUP(X,0))
.Q:$P(^AMHRRUP(X,0),U,1)'=Y
.S AMHPCNT=AMHPCNT+1,AMHPRNM(AMHPCNT)=$$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",AMHVAL,0))
I Y="" Q ""
S X=0 F S X=$O(^AMHRRUP("AD",AMHVIEN,X)) Q:X'=+X D
.Q:$P($G(^AMHRRUP(X,2)),U,1) ;error
.Q:'$D(^AMHRRUP(X,0))
.Q:$P(^AMHRRUP(X,0),U,1)'=Y
.S Z=$P($G(^AMHRRUP(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",AMHVAL,0))
I Y="" Q ""
S X=0 F S X=$O(^AMHRRUP("AD",AMHVIEN,X)) Q:X'=+X D
.Q:$P($G(^AMHRRUP(X,2)),U,1) ;error
.Q:'$D(^AMHRRUP(X,0))
.Q:$P(^AMHRRUP(X,0),U,1)'=Y
.Q:$P($G(^AMHRRUP(X,12)),U,4)=""
.S AMHPCNT=AMHPCNT+1,AMHPRNM(AMHPCNT)=$$VAL^XBDIQ1(9000010.54,X,1204)
.Q
Q
AMHAPI6 ; IHS/CMI/LAB - visit data ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;**2**;JUN 18, 2010;Build 23
+2 ;IHS/TUCSON/LAB - added G parameter to provider call
+3 ;
+4 ;
+5 ;
LASTPLR(AMHPDFN,AMHBD,AMHED,AMHFORM) ;PEP - date of last PROBLEM LIST REVIEWED
+1 ; Return the last recorded PROBLEM LIST REVIEWED FROM MHSS UPDATED/REVIEWED:
+2 ; .04 OF MHSS UPDATED/REVIEWED is set to 1
+3 ;
+4 ; Input:
+5 ; AMHPDFN - Patient DFN
+6 ; AMHBD - beginning date to begin search for value - if blank, default is DOB
+7 ; AMHED - ending date of search - if blank, default is DT
+8 ; AMHFORM - AMHFORM 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 AMHFORM is blank or AMHFORM is D returns internal fileman date if one found otherwise returns null
+14 ; If AMHFORM 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(AMHPDFN)=""
QUIT ""
+18 IF $GET(AMHBD)=""
SET AMHBD=$$DOB^AUPNPAT(AMHPDFN)
+19 IF $GET(AMHED)=""
SET AMHED=DT
+20 IF $GET(AMHFORM)=""
SET AMHFORM="D"
+21 NEW AMHLAST,AMHVAL,AMHX,R,X,Y,V,E,D,G,ED,BD
+22 SET BD=9999999-AMHBD
+23 SET ED=9999999-AMHED
+24 SET AMHLAST=""
+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(^AMHRRUP("AA",AMHPDFN,V,D))
IF D'=+D!($PIECE(D,".")>BD)
QUIT
Begin DoDot:1
+28 SET X=0
FOR
SET X=$ORDER(^AMHRRUP("AA",AMHPDFN,V,D,X))
IF X'=+X
QUIT
Begin DoDot:2
+29 IF '$DATA(^AMHRRUP(X,0))
QUIT
+30 IF $PIECE($GET(^AMHRRUP(X,2)),U,1)
QUIT
+31 SET AMHVAL=$PIECE($PIECE(^AMHRRUP(X,12),U),".")_U_$$VAL^XBDIQ1(9000010.54,X,.01)_U_$PIECE($GET(^AMHRRUP(X,12)),U,4)_U_$PIECE(^AMHRRUP(X,0),U,3)_U_9000010.54_U_X
+32 DO E
End DoDot:2
End DoDot:1
+33 IF AMHFORM="D"
QUIT $PIECE(AMHLAST,U)
+34 QUIT AMHLAST
+35 ;
E ;
+1 IF $PIECE(AMHVAL,U,1)'<$PIECE(AMHLAST,U,1)
SET AMHLAST=AMHVAL
+2 QUIT
LASTPLU(AMHPDFN,AMHBD,AMHED,AMHFORM) ;PEP - date of last PROBLEM LIST UPDATE
+1 ; Return the last recorded PROBLEM LIST UPDATED FROM MHSS UPDATED/REVIEWED:
+2 ; .11 OF MHSS UPDATED/REVIEWED is set to 1
+3 ;
+4 ; Input:
+5 ; AMHPDFN - Patient DFN
+6 ; AMHBD - beginning date to begin search for value - if blank, default is DOB
+7 ; AMHED - ending date of search - if blank, default is DT
+8 ; AMHFORM - AMHFORM 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 AMHFORM is blank or AMHFORM is D returns internal fileman date if one found otherwise returns null
+14 ; If AMHFORM 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(AMHPDFN)=""
QUIT ""
+18 IF $GET(AMHBD)=""
SET AMHBD=$$DOB^AUPNPAT(AMHPDFN)
+19 IF $GET(AMHED)=""
SET AMHED=DT
+20 IF $GET(AMHFORM)=""
SET AMHFORM="D"
+21 NEW AMHLAST,AMHVAL,AMHX,R,X,Y,V,E,D,G,ED,BD
+22 SET BD=9999999-AMHBD
+23 SET ED=9999999-AMHED
+24 SET AMHLAST=""
+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(^AMHRRUP("AA",AMHPDFN,V,D))
IF D'=+D!($PIECE(D,".")>BD)
QUIT
Begin DoDot:1
+28 SET X=0
FOR
SET X=$ORDER(^AMHRRUP("AA",AMHPDFN,V,D,X))
IF X'=+X
QUIT
Begin DoDot:2
+29 IF '$DATA(^AMHRRUP(X,0))
QUIT
+30 IF $PIECE($GET(^AMHRRUP(X,2)),U,1)
QUIT
+31 SET AMHVAL=$PIECE($PIECE(^AMHRRUP(X,12),U),".")_U_$$VAL^XBDIQ1(9000010.54,X,.01)_U_$PIECE($GET(^AMHRRUP(X,12)),U,4)_U_$PIECE(^AMHRRUP(X,0),U,3)_U_9000010.54_U_X
+32 DO E
End DoDot:2
End DoDot:1
+33 IF AMHFORM="D"
QUIT $PIECE(AMHLAST,U)
+34 QUIT AMHLAST
+35 ;
LASTNAP(AMHPDFN,AMHBD,AMHED,AMHFORM) ;PEP - date of last NO ACTIVE PROBLEMS
+1 ; Return the last recorded NO ACTIVE PROBLEMS FROM MHSS UPDATED/REVIEWED:
+2 ; .09 OF MHSS UPDATED/REVIEWED is set to 1
+3 ;
+4 ; Input:
+5 ; AMHPDFN - Patient DFN
+6 ; AMHBD - beginning date to begin search for value - if blank, default is DOB
+7 ; AMHED - ending date of search - if blank, default is DT
+8 ; AMHFORM - AMHFORM 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 AMHFORM is blank or AMHFORM is D returns internal fileman date if one found otherwise returns null
+14 ; If AMHFORM 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(AMHPDFN)=""
QUIT ""
+18 IF $GET(AMHBD)=""
SET AMHBD=$$DOB^AUPNPAT(AMHPDFN)
+19 IF $GET(AMHED)=""
SET AMHED=DT
+20 IF $GET(AMHFORM)=""
SET AMHFORM="D"
+21 NEW AMHLAST,AMHVAL,AMHX,R,X,Y,V,E,D,G,ED,BD
+22 SET BD=9999999-AMHBD
+23 SET ED=9999999-AMHED
+24 SET AMHLAST=""
+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(^AMHRRUP("AA",AMHPDFN,V,D))
IF D'=+D!($PIECE(D,".")>BD)
QUIT
Begin DoDot:1
+28 SET X=0
FOR
SET X=$ORDER(^AMHRRUP("AA",AMHPDFN,V,D,X))
IF X'=+X
QUIT
Begin DoDot:2
+29 IF '$DATA(^AMHRRUP(X,0))
QUIT
+30 IF $PIECE($GET(^AMHRRUP(X,2)),U,1)
QUIT
+31 SET AMHVAL=$PIECE($PIECE(^AMHRRUP(X,12),U),".")_U_$$VAL^XBDIQ1(9000010.54,X,.01)_U_$PIECE($GET(^AMHRRUP(X,12)),U,4)_U_$PIECE(^AMHRRUP(X,0),U,3)_U_9000010.54_U_X
+32 DO E
End DoDot:2
End DoDot:1
+33 IF AMHFORM="D"
QUIT $PIECE(AMHLAST,U)
+34 QUIT AMHLAST
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(^AMHRRUP("AD",V,X))
IF X'=+X
QUIT
Begin DoDot:1
+8 ;error
IF $PIECE($GET(^AMHRRUP(X,2)),U,1)
QUIT
+9 IF '$DATA(^AMHRRUP(X,0))
QUIT
+10 IF $PIECE(^AMHRRUP(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",AMHVAL,0))
+4 IF Y=""
QUIT ""
+5 SET X=0
FOR
SET X=$ORDER(^AMHRRUP("AD",AMHVIEN,X))
IF X'=+X
QUIT
Begin DoDot:1
+6 ;error
IF $PIECE($GET(^AMHRRUP(X,2)),U,1)
QUIT
+7 IF '$DATA(^AMHRRUP(X,0))
QUIT
+8 IF $PIECE(^AMHRRUP(X,0),U,1)'=Y
QUIT
+9 SET AMHPCNT=AMHPCNT+1
SET AMHPRNM(AMHPCNT)=$$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",AMHVAL,0))
+4 IF Y=""
QUIT ""
+5 SET X=0
FOR
SET X=$ORDER(^AMHRRUP("AD",AMHVIEN,X))
IF X'=+X
QUIT
Begin DoDot:1
+6 ;error
IF $PIECE($GET(^AMHRRUP(X,2)),U,1)
QUIT
+7 IF '$DATA(^AMHRRUP(X,0))
QUIT
+8 IF $PIECE(^AMHRRUP(X,0),U,1)'=Y
QUIT
+9 SET Z=$PIECE($GET(^AMHRRUP(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",AMHVAL,0))
+4 IF Y=""
QUIT ""
+5 SET X=0
FOR
SET X=$ORDER(^AMHRRUP("AD",AMHVIEN,X))
IF X'=+X
QUIT
Begin DoDot:1
+6 ;error
IF $PIECE($GET(^AMHRRUP(X,2)),U,1)
QUIT
+7 IF '$DATA(^AMHRRUP(X,0))
QUIT
+8 IF $PIECE(^AMHRRUP(X,0),U,1)'=Y
QUIT
+9 IF $PIECE($GET(^AMHRRUP(X,12)),U,4)=""
QUIT
+10 SET AMHPCNT=AMHPCNT+1
SET AMHPRNM(AMHPCNT)=$$VAL^XBDIQ1(9000010.54,X,1204)
+11 QUIT
End DoDot:1
+12 QUIT
