AMHSC2 ; IHS/CMI/LAB - SPECIAL X-REF ROUTINES - ;
;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
;
; AMHGREF - Primary Global Reference
; AMHSBJGR - Subject Global Reference - Used if all of the entries are to be used under this node -- don't need to check a date
; AMHRVCRO - Reverse chronological date subscripted
;
SETUP ;
S BGUCRFS=""
S AMHVWNO=$P(BGUEND,"`",2),AMHLBONL=$P(BGUEND,"`",3),AMHRVCRO=1
S AMHVWOPT=$P(BGUEND,"`",4),BGUMAX=$S('AMHVWOPT:AMHVWNO,1:999999999)
S (BGUBEGIN,BGUEND,AMHXLEVL)="",AMHC=0
Q
;
VISIT ;
I AMHSBJGR="" S AMHC=AMHC+1,BGUSUB(1)=AMHVIEN,BGUV(BGUFILE,88888)=$$PRIMPROV^APCLV(AMHVIEN,"N") D FIELDS^BGULIST Q
S AMHSIEN=0 F S AMHSIEN=$O(@AMHSBJGR@(AMHSIEN)) Q:'AMHSIEN S AMHC=AMHC+1,BGUSUB(1)=AMHSIEN,BGUV(BGUFILE,88888)=$$PRIMPROV^APCLV(AMHSIEN,"N") D FIELDS^BGULIST
Q
;
VSDTRNG ; Get visits for a patient for a date range
S AMHGREF=$G(AMHGREF,"^AUPNVSIT(""AA"",AMHPIEN)")
S AMHPIEN=$P(BGUBEGIN,"`"),BGUBEGIN=$P(BGUBEGIN,"`",2)
D VSDTDR
Q
VSDTDR ;
I '$D(BGUDRIVR) D Q
.S BGUDRIVR="VSDTDR^AMHSC2",AMHSDATE=BGUBEGIN,AMHEDATE=$P(BGUEND,"`",1)
.S AMHSDATE=$P(BGUEND,"`",1),AMHEDATE=$P(BGUEND,"`",2)
.S AMHVWNO=$P(BGUEND,"`",3),AMHLBONL=$P(BGUEND,"`",4)
.S AMHVWOPT=$P(BGUEND,"`",5),BGUMAX=$S('AMHVWOPT:AMHVWNO,1:999999)
.D SETUP
S AMHVWOPT="2",AMHSBJGR=$G(AMHSBJGR)
D VSDTDR1,KILL
Q
VSDTDR1 ;
S:'(+AMHVWNO) AMHVWNO=10 S:AMHSDATE="" AMHSDATE="1/1/1980"
S:AMHEDATE="" AMHEDATE="T" S:AMHVWOPT="" AMHVWOPT="0"
S:AMHLBONL="" AMHLBONL="1"
D DT^DILF("",AMHSDATE,.AMHSDAT)
I AMHSDAT=-1 S AMHSDATE="1/1/1980" D DT^DILF("",AMHSDATE,.AMHSDAT)
D DT^DILF("",AMHEDATE,.AMHEDAT)
I AMHEDAT=-1 S AMHEDATE="T" D DT^DILF("",AMHEDATE,.AMHEDAT)
S AMHC=0,AMHX=0,AMHLIM=$S(AMHVWOPT="0":AMHVWNO,1:999999)
I AMHRVCRO S AMHSDAT=9999999-AMHSDAT,AMHEDAT=9999999-AMHEDAT
I AMHXLEVL'="" D @AMHXLEVL Q
VSDTDR2 ;
I AMHRVCRO D Q
.S AMHX=$O(@AMHGREF@(AMHEDAT),-1) F S AMHX=$O(@AMHGREF@(AMHX)) Q:'AMHX Q:AMHX\1>AMHSDAT D Q:AMHC=AMHLIM
..S AMHVIEN=0 F S AMHVIEN=$O(@AMHGREF@(AMHX,AMHVIEN)) Q:'AMHVIEN Q:AMHC=AMHLIM D VISIT
S AMHX=$O(@AMHGREF@(AMHSDAT),-1) F S AMHX=$O(@AMHGREF@(AMHX)) Q:'AMHX Q:AMHX\1>AMHEDAT D Q:AMHC=AMHLIM
.S AMHVIEN=0 F S AMHVIEN=$O(@AMHGREF@(AMHX,AMHVIEN)) Q:'AMHVIEN Q:AMHC=AMHLIM D VISIT
Q
;
VED ; Get V PATIENT ED
;
S AMHGREF="^AUPNVPED(""AA"",AMHPIEN)"
D VSDTRNG
Q
;
VHF ; Get V HEALTH FACTORS
S AMHGREF="^AUPNVHF(""AA"",AMHPIEN)",AMHXLEVL="VHF1"
D VSDTRNG
Q
;
VHF1 ; V HEALTH FACTORS XTRA level
S AMHGREF="^AUPNVHF(""AA"",AMHPIEN,AMHXL)"
S AMHXL=0 F S AMHXL=$O(@AMHGREF) Q:'AMHXL D VSDTDR2
Q
;
VEXAM ; Get V EXAMS
S AMHGREF="^AUPNVXAM(""AA"",AMHPIEN)",AMHXLEVL="VEXAM1"
D VSDTRNG
Q
;
VEXAM1 ; V EXAMS XTRA level
S AMHGREF="^AUPNVXAM(""AA"",AMHPIEN,AMHXL)"
S AMHXL=0 F S AMHXL=$O(@AMHGREF) Q:'AMHXL D VSDTDR2
Q
;
KILL ;
K BGUDRIVR,AMHC,AMHEDATE,AMHGREF,AMHGROUP,AMHLBONL,AMHLIM,AMHPIEN,AMHSBJGR,AMHSDATE,AMHSIEN,AMHRVCRO,AMHVIEN,AMHVWNO,AMHVWOPT,AMHX,AMHXL,AMHXLEVL
Q
AMHSC2 ; IHS/CMI/LAB - SPECIAL X-REF ROUTINES - ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
+2 ;
+3 ; AMHGREF - Primary Global Reference
+4 ; AMHSBJGR - Subject Global Reference - Used if all of the entries are to be used under this node -- don't need to check a date
+5 ; AMHRVCRO - Reverse chronological date subscripted
+6 ;
SETUP ;
+1 SET BGUCRFS=""
+2 SET AMHVWNO=$PIECE(BGUEND,"`",2)
SET AMHLBONL=$PIECE(BGUEND,"`",3)
SET AMHRVCRO=1
+3 SET AMHVWOPT=$PIECE(BGUEND,"`",4)
SET BGUMAX=$SELECT('AMHVWOPT:AMHVWNO,1:999999999)
+4 SET (BGUBEGIN,BGUEND,AMHXLEVL)=""
SET AMHC=0
+5 QUIT
+6 ;
VISIT ;
+1 IF AMHSBJGR=""
SET AMHC=AMHC+1
SET BGUSUB(1)=AMHVIEN
SET BGUV(BGUFILE,88888)=$$PRIMPROV^APCLV(AMHVIEN,"N")
DO FIELDS^BGULIST
QUIT
+2 SET AMHSIEN=0
FOR
SET AMHSIEN=$ORDER(@AMHSBJGR@(AMHSIEN))
IF 'AMHSIEN
QUIT
SET AMHC=AMHC+1
SET BGUSUB(1)=AMHSIEN
SET BGUV(BGUFILE,88888)=$$PRIMPROV^APCLV(AMHSIEN,"N")
DO FIELDS^BGULIST
+3 QUIT
+4 ;
VSDTRNG ; Get visits for a patient for a date range
+1 SET AMHGREF=$GET(AMHGREF,"^AUPNVSIT(""AA"",AMHPIEN)")
+2 SET AMHPIEN=$PIECE(BGUBEGIN,"`")
SET BGUBEGIN=$PIECE(BGUBEGIN,"`",2)
+3 DO VSDTDR
+4 QUIT
VSDTDR ;
+1 IF '$DATA(BGUDRIVR)
Begin DoDot:1
+2 SET BGUDRIVR="VSDTDR^AMHSC2"
SET AMHSDATE=BGUBEGIN
SET AMHEDATE=$PIECE(BGUEND,"`",1)
+3 SET AMHSDATE=$PIECE(BGUEND,"`",1)
SET AMHEDATE=$PIECE(BGUEND,"`",2)
+4 SET AMHVWNO=$PIECE(BGUEND,"`",3)
SET AMHLBONL=$PIECE(BGUEND,"`",4)
+5 SET AMHVWOPT=$PIECE(BGUEND,"`",5)
SET BGUMAX=$SELECT('AMHVWOPT:AMHVWNO,1:999999)
+6 DO SETUP
End DoDot:1
QUIT
+7 SET AMHVWOPT="2"
SET AMHSBJGR=$GET(AMHSBJGR)
+8 DO VSDTDR1
DO KILL
+9 QUIT
VSDTDR1 ;
+1 IF '(+AMHVWNO)
SET AMHVWNO=10
IF AMHSDATE=""
SET AMHSDATE="1/1/1980"
+2 IF AMHEDATE=""
SET AMHEDATE="T"
IF AMHVWOPT=""
SET AMHVWOPT="0"
+3 IF AMHLBONL=""
SET AMHLBONL="1"
+4 DO DT^DILF("",AMHSDATE,.AMHSDAT)
+5 IF AMHSDAT=-1
SET AMHSDATE="1/1/1980"
DO DT^DILF("",AMHSDATE,.AMHSDAT)
+6 DO DT^DILF("",AMHEDATE,.AMHEDAT)
+7 IF AMHEDAT=-1
SET AMHEDATE="T"
DO DT^DILF("",AMHEDATE,.AMHEDAT)
+8 SET AMHC=0
SET AMHX=0
SET AMHLIM=$SELECT(AMHVWOPT="0":AMHVWNO,1:999999)
+9 IF AMHRVCRO
SET AMHSDAT=9999999-AMHSDAT
SET AMHEDAT=9999999-AMHEDAT
+10 IF AMHXLEVL'=""
DO @AMHXLEVL
QUIT
VSDTDR2 ;
+1 IF AMHRVCRO
Begin DoDot:1
+2 SET AMHX=$ORDER(@AMHGREF@(AMHEDAT),-1)
FOR
SET AMHX=$ORDER(@AMHGREF@(AMHX))
IF 'AMHX
QUIT
IF AMHX\1>AMHSDAT
QUIT
Begin DoDot:2
+3 SET AMHVIEN=0
FOR
SET AMHVIEN=$ORDER(@AMHGREF@(AMHX,AMHVIEN))
IF 'AMHVIEN
QUIT
IF AMHC=AMHLIM
QUIT
DO VISIT
End DoDot:2
IF AMHC=AMHLIM
QUIT
End DoDot:1
QUIT
+4 SET AMHX=$ORDER(@AMHGREF@(AMHSDAT),-1)
FOR
SET AMHX=$ORDER(@AMHGREF@(AMHX))
IF 'AMHX
QUIT
IF AMHX\1>AMHEDAT
QUIT
Begin DoDot:1
+5 SET AMHVIEN=0
FOR
SET AMHVIEN=$ORDER(@AMHGREF@(AMHX,AMHVIEN))
IF 'AMHVIEN
QUIT
IF AMHC=AMHLIM
QUIT
DO VISIT
End DoDot:1
IF AMHC=AMHLIM
QUIT
+6 QUIT
+7 ;
VED ; Get V PATIENT ED
+1 ;
+2 SET AMHGREF="^AUPNVPED(""AA"",AMHPIEN)"
+3 DO VSDTRNG
+4 QUIT
+5 ;
VHF ; Get V HEALTH FACTORS
+1 SET AMHGREF="^AUPNVHF(""AA"",AMHPIEN)"
SET AMHXLEVL="VHF1"
+2 DO VSDTRNG
+3 QUIT
+4 ;
VHF1 ; V HEALTH FACTORS XTRA level
+1 SET AMHGREF="^AUPNVHF(""AA"",AMHPIEN,AMHXL)"
+2 SET AMHXL=0
FOR
SET AMHXL=$ORDER(@AMHGREF)
IF 'AMHXL
QUIT
DO VSDTDR2
+3 QUIT
+4 ;
VEXAM ; Get V EXAMS
+1 SET AMHGREF="^AUPNVXAM(""AA"",AMHPIEN)"
SET AMHXLEVL="VEXAM1"
+2 DO VSDTRNG
+3 QUIT
+4 ;
VEXAM1 ; V EXAMS XTRA level
+1 SET AMHGREF="^AUPNVXAM(""AA"",AMHPIEN,AMHXL)"
+2 SET AMHXL=0
FOR
SET AMHXL=$ORDER(@AMHGREF)
IF 'AMHXL
QUIT
DO VSDTDR2
+3 QUIT
+4 ;
KILL ;
+1 KILL BGUDRIVR,AMHC,AMHEDATE,AMHGREF,AMHGROUP,AMHLBONL,AMHLIM,AMHPIEN,AMHSBJGR,AMHSDATE,AMHSIEN,AMHRVCRO,AMHVIEN,AMHVWNO,AMHVWOPT,AMHX,AMHXL,AMHXLEVL
+2 QUIT
