- 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
