- AMHBHSC ; IHS/CMI/LAB - BEHAVIORAL HEALTH SPECIAL CROSSREFERENCE FOR GUI ;
- ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
- ;
- ; AMHSETLV - Setting Primary List view - Assumes MH Encounter is central
- ; AMHCTYPE - Screen to Admin Type
- ; 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
- ; AMHDIVAL - Look at all divisions - Not used here, used to screen patients selected prior to calling this routine
- ; AMHBHALL - Look at all users' entries - Only relates to MH REC
- ;
- SETUP ;
- S BGUCRFS="",AMHVTYPE=$G(AMHVTYPE)
- S:'$D(AMHGREF) AMHVTYPE=1,AMHGREF="^AMHREC(""AF"",AMHPIEN)"
- S:BGUMAX=25 BGUMAX=0 S AMHLIM=BGUMAX,BGUMAX=999999999 S:'AMHLIM AMHLIM=BGUMAX
- S AMHDIR=1 S:BGUDIR="B" AMHDIR=-1 S BGUDIR=""
- S (BGUBEGIN,BGUEND)="",AMHC=0,AMHGROUP=$G(AMHGROUP),AMHSETLV=$G(AMHSETLV,1),AMHDIVAL=1
- Q
- ;
- MHRC ; Get records for a patient by date range
- ;S AMHGREF=$G(AMHGREF,"^AMHREC(""AF"",AMHPIEN)")
- S AMHPIEN=$P(BGUBEGIN,"`"),BGUBEGIN=$P(BGUBEGIN,"`",2)
- D MHREC
- Q
- ;
- MHENC ; Get records for an encounter
- I '$D(BGUDRIVR) S BGUDRIVR="MHENC^AMHBHSC",AMHVIEN=BGUBEGIN D SETUP Q
- D:AMHVIEN'="" MHENCTR
- D KILL
- Q
- ;
- MHREC ;
- I '$D(BGUDRIVR) S BGUDRIVR="MHREC^AMHBHSC",AMHSDATE=$P(BGUBEGIN,"`"),AMHVIEN=$P(BGUBEGIN,"`",2),AMHEDATE=$P(BGUEND,"`",1) D SETUP Q
- S AMHVWOPT="2",AMHSBJGR=$G(AMHSBJGR),AMHCTYPE=$G(AMHCTYPE),AMHDTCK=$G(AMHDTCK)
- D MHREC1,KILL
- Q
- MHREC1 ;
- D
- .I AMHSDATE'=+AMHSDATE D Q
- ..S:AMHSDATE="" AMHSDATE="1/1/1980"
- ..S:AMHEDATE="" AMHEDATE="T"
- ..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:AMHDIR<0 AMHEDAT=AMHEDAT+.9999
- .S AMHSDAT=AMHSDATE,AMHEDAT=AMHEDATE
- S AMHCTYPE=$G(AMHCTYPE)
- S AMHC=0,AMHX=0 ;,AMHLIM=$S(AMHVWOPT="0":AMHVWNO,1:999999)
- I AMHDTCK'="" D @AMHDTCK Q
- S AMHX=$S(AMHDIR>0:$O(@AMHGREF@(AMHSDAT),-1),1:$O(@AMHGREF@(AMHEDAT))) F S AMHX=$O(@AMHGREF@(AMHX),AMHDIR) Q:'AMHX Q:$S(AMHDIR>0:AMHX\1>AMHEDAT,1:AMHX\1<AMHSDAT) D Q:AMHC=AMHLIM
- .F S AMHVIEN=$O(@AMHGREF@(AMHX,AMHVIEN)) Q:'AMHVIEN Q:AMHC=AMHLIM D MHENCTR
- Q
- ;
- MHENCTR ;
- I AMHCTYPE'="",$P(^AMHREC(AMHVIEN,0),U,7)'=AMHCTYPE Q
- S AMHBHALL=1 I AMHVTYPE S AMHBHALL=0,AMHXX=$S(AMHGROUP:$P(^AMHGROUP(AMHVIEN,0),U,5),1:$P(^AMHREC(AMHVIEN,0),U,4)) I AMHXX,$D(^AMHSITE(AMHXX,16,DUZ)) S AMHBHALL=1
- I 'AMHBHALL,$S(AMHGROUP:$P(^AMHGROUP(AMHVIEN,0),U,15)'=DUZ,1:$P(^AMHREC(AMHVIEN,0),U,19)'=DUZ) S BGUV(BGUFILE,88888)=0 D Q:'BGUV(BGUFILE,88888)
- .I AMHGROUP D Q
- ..F S BGUV(BGUFILE,88888)=$O(^AMHGROUP(AMHVIEN,11,BGUV(BGUFILE,88888))) Q:'BGUV(BGUFILE,88888) Q:$P(^AMHGROUP(AMHVIEN,11,BGUV(BGUFILE,88888),0),U)=DUZ
- .F S BGUV(BGUFILE,88888)=$O(^AMHRPROV("AD",AMHVIEN,BGUV(BGUFILE,88888))) Q:'BGUV(BGUFILE,88888) Q:$P(^AMHRPROV(BGUV(BGUFILE,88888),0),U)=DUZ
- D
- .I 'AMHGROUP D:AMHSETLV Q ;PICKUP ALL THESE FIELDS IF AMHSETLV IS SET, INSTEAD OF REQUIRING THEIR OWN FLAGS
- ..S BGUV(BGUFILE,666666)=$O(^AMHREDU("AD",AMHVIEN,0))
- ..S BGUV(BGUFILE,777777)=$O(^AMHRHF("AD",AMHVIEN,0))
- ..S BGUV(BGUFILE,99999)=$O(^AMHRPRO("AD",AMHVIEN,0))
- ..S BGUV(BGUFILE,88888)=0 D
- ...F S BGUV(BGUFILE,88888)=$O(^AMHRPROV("AD",AMHVIEN,BGUV(BGUFILE,88888))) Q:BGUV(BGUFILE,88888)="" Q:$P(^AMHRPROV(BGUV(BGUFILE,88888),0),U,4)="P"
- .I AMHSETLV D
- ..S BGUV(BGUFILE,99999)=$O(^AMHGROUP(AMHVIEN,21,0)) S:BGUV(BGUFILE,99999) BGUV(BGUFILE,99999)=$P(^(BGUV(BGUFILE,99999),0),U)
- ..S BGUV(BGUFILE,88888)=0 D
- ..F S BGUV(BGUFILE,88888)=$O(^AMHGROUP(AMHVIEN,11,BGUV(BGUFILE,88888))) Q:'BGUV(BGUFILE,88888) I $P(^AMHGROUP(AMHVIEN,11,BGUV(BGUFILE,88888),0),U,2)="P" S BGUV(BGUFILE,88888)=$P(^(0),U) Q
- I AMHSBJGR="" S BGUSUB(1)=AMHVIEN,BGUV(BGUFILE,.0001)=AMHX D FIELDS^BGULIST S AMHC=BGUICNT Q
- S AMHSIEN=0 F S AMHSIEN=$O(@AMHSBJGR@(AMHSIEN)) Q:'AMHSIEN S AMHC=AMHC+1,BGUSUB(1)=AMHSIEN,BGUV(BGUFILE,.0001)=AMHX D FIELDS^BGULIST S AMHC=BGUICNT
- Q
- ;
- ADM ; Get Administration Entries
- S AMHCTYPE=$O(^AMHTSET("B","ADMINISTRATIVE",""))
- AD ; Get AD xref entries
- S AMHBHALL=1,AMHGREF="^AMHREC(""B"")",AMHVTYPE=1
- D MHREC
- Q
- ;
- MHCASE ;
- S AMHGREF="^AMHPCASE(""C"",AMHPIEN)",AMHDTCK="MHCASE1"
- D MHRC
- Q
- ;
- MHCASE1 ;
- S AMHVIEN=0 F S AMHVIEN=$O(@AMHGREF@(AMHVIEN)) Q:'AMHVIEN Q:AMHC=AMHLIM S AMHX=$P(^AMHPCASE(AMHVIEN,0),U,1) I AMHX'<AMHSDAT,AMHX'>AMHEDAT D MHENCTR
- Q
- ;
- MHTREAT ;
- S AMHGREF="^AMHPTXP(""AC"",AMHPIEN)",AMHDTCK="MHTREAT1",AMHSETLV=""
- D MHRC
- Q
- ;
- MHTREAT1 ;
- S AMHVIEN=0 F S AMHVIEN=$O(@AMHGREF@(AMHVIEN)) Q:'AMHVIEN Q:AMHC=AMHLIM S AMHX=$P(^AMHPTXP(AMHVIEN,0),U,1) I AMHX'<AMHSDAT,AMHX'>AMHEDAT D MHENCTR
- Q
- ;
- MHSUIV ;
- S AMHGREF="^AMHPSUIC(""AD"")",AMHSETLV=""
- D MHREC
- Q
- ;
- MHSUI ;
- S AMHGREF="^AMHPSUIC(""AC"",AMHPIEN)",AMHDTCK="MHSUI1",AMHSETLV=""
- D MHRC
- Q
- ;
- MHSUI1 ;
- S AMHVIEN=0 F S AMHVIEN=$O(@AMHGREF@(AMHVIEN)) Q:'AMHVIEN Q:AMHC=AMHLIM S AMHX=$P(^AMHPSUIC(AMHVIEN,0),U,6) I AMHX'<AMHSDAT,AMHX'>AMHEDAT D MHENCTR
- Q
- ;
- HF ; Health Factors
- S AMHSBJGR="^AMHRHF(""AD"",AMHVIEN)",AMHSETLV=0,AMHCTYPE=""
- D MHENC
- Q
- ;
- EDU ; Patient Education
- S AMHSBJGR="^AMHREDU(""AD"",AMHVIEN)",AMHSETLV=0,AMHCTYPE=""
- D MHENC
- Q
- ;
- MHGRP ;
- S AMHGREF="^AMHGROUP(""B"")",AMHGROUP=1,AMHVTYPE=1
- D MHREC
- Q
- ;
- KILL ;
- K BGUDRIVR,AMHC,AMHCTYPE,AMHDIVAL,AMHDTCK,AMHEDATE,AMHGREF,AMHGROUP,AMHBHALL,AMHLBONL,AMHLIM,AMHPIEN,AMHSBJGR,AMHSDATE,AMHSETLV,AMHSIEN,AMHVIEN,AMHVTYPE,AMHVWNO,AMHVWOPT,AMHX,AMHXX
- Q
- AMHBHSC ; IHS/CMI/LAB - BEHAVIORAL HEALTH SPECIAL CROSSREFERENCE FOR GUI ;
- +1 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
- +2 ;
- +3 ; AMHSETLV - Setting Primary List view - Assumes MH Encounter is central
- +4 ; AMHCTYPE - Screen to Admin Type
- +5 ; AMHGREF - Primary Global Reference
- +6 ; AMHSBJGR - Subject Global Reference - Used if all of the entries are to be used under this node -- don't need to check a date
- +7 ; AMHDIVAL - Look at all divisions - Not used here, used to screen patients selected prior to calling this routine
- +8 ; AMHBHALL - Look at all users' entries - Only relates to MH REC
- +9 ;
- SETUP ;
- +1 SET BGUCRFS=""
- SET AMHVTYPE=$GET(AMHVTYPE)
- +2 IF '$DATA(AMHGREF)
- SET AMHVTYPE=1
- SET AMHGREF="^AMHREC(""AF"",AMHPIEN)"
- +3 IF BGUMAX=25
- SET BGUMAX=0
- SET AMHLIM=BGUMAX
- SET BGUMAX=999999999
- IF 'AMHLIM
- SET AMHLIM=BGUMAX
- +4 SET AMHDIR=1
- IF BGUDIR="B"
- SET AMHDIR=-1
- SET BGUDIR=""
- +5 SET (BGUBEGIN,BGUEND)=""
- SET AMHC=0
- SET AMHGROUP=$GET(AMHGROUP)
- SET AMHSETLV=$GET(AMHSETLV,1)
- SET AMHDIVAL=1
- +6 QUIT
- +7 ;
- MHRC ; Get records for a patient by date range
- +1 ;S AMHGREF=$G(AMHGREF,"^AMHREC(""AF"",AMHPIEN)")
- +2 SET AMHPIEN=$PIECE(BGUBEGIN,"`")
- SET BGUBEGIN=$PIECE(BGUBEGIN,"`",2)
- +3 DO MHREC
- +4 QUIT
- +5 ;
- MHENC ; Get records for an encounter
- +1 IF '$DATA(BGUDRIVR)
- SET BGUDRIVR="MHENC^AMHBHSC"
- SET AMHVIEN=BGUBEGIN
- DO SETUP
- QUIT
- +2 IF AMHVIEN'=""
- DO MHENCTR
- +3 DO KILL
- +4 QUIT
- +5 ;
- MHREC ;
- +1 IF '$DATA(BGUDRIVR)
- SET BGUDRIVR="MHREC^AMHBHSC"
- SET AMHSDATE=$PIECE(BGUBEGIN,"`")
- SET AMHVIEN=$PIECE(BGUBEGIN,"`",2)
- SET AMHEDATE=$PIECE(BGUEND,"`",1)
- DO SETUP
- QUIT
- +2 SET AMHVWOPT="2"
- SET AMHSBJGR=$GET(AMHSBJGR)
- SET AMHCTYPE=$GET(AMHCTYPE)
- SET AMHDTCK=$GET(AMHDTCK)
- +3 DO MHREC1
- DO KILL
- +4 QUIT
- MHREC1 ;
- +1 Begin DoDot:1
- +2 IF AMHSDATE'=+AMHSDATE
- Begin DoDot:2
- +3 IF AMHSDATE=""
- SET AMHSDATE="1/1/1980"
- +4 IF AMHEDATE=""
- SET AMHEDATE="T"
- +5 DO DT^DILF("",AMHSDATE,.AMHSDAT)
- +6 IF AMHSDAT=-1
- SET AMHSDATE="1/1/1980"
- DO DT^DILF("",AMHSDATE,.AMHSDAT)
- +7 DO DT^DILF("",AMHEDATE,.AMHEDAT)
- +8 IF AMHEDAT=-1
- SET AMHEDATE="T"
- DO DT^DILF("",AMHEDATE,.AMHEDAT)
- +9 IF AMHDIR<0
- SET AMHEDAT=AMHEDAT+.9999
- End DoDot:2
- QUIT
- +10 SET AMHSDAT=AMHSDATE
- SET AMHEDAT=AMHEDATE
- End DoDot:1
- +11 SET AMHCTYPE=$GET(AMHCTYPE)
- +12 ;,AMHLIM=$S(AMHVWOPT="0":AMHVWNO,1:999999)
- SET AMHC=0
- SET AMHX=0
- +13 IF AMHDTCK'=""
- DO @AMHDTCK
- QUIT
- +14 SET AMHX=$SELECT(AMHDIR>0:$ORDER(@AMHGREF@(AMHSDAT),-1),1:$ORDER(@AMHGREF@(AMHEDAT)))
- FOR
- SET AMHX=$ORDER(@AMHGREF@(AMHX),AMHDIR)
- IF 'AMHX
- QUIT
- IF $SELECT(AMHDIR>0
- QUIT
- Begin DoDot:1
- +15 FOR
- SET AMHVIEN=$ORDER(@AMHGREF@(AMHX,AMHVIEN))
- IF 'AMHVIEN
- QUIT
- IF AMHC=AMHLIM
- QUIT
- DO MHENCTR
- End DoDot:1
- IF AMHC=AMHLIM
- QUIT
- +16 QUIT
- +17 ;
- MHENCTR ;
- +1 IF AMHCTYPE'=""
- IF $PIECE(^AMHREC(AMHVIEN,0),U,7)'=AMHCTYPE
- QUIT
- +2 SET AMHBHALL=1
- IF AMHVTYPE
- SET AMHBHALL=0
- SET AMHXX=$SELECT(AMHGROUP:$PIECE(^AMHGROUP(AMHVIEN,0),U,5),1:$PIECE(^AMHREC(AMHVIEN,0),U,4))
- IF AMHXX
- IF $DATA(^AMHSITE(AMHXX,16,DUZ))
- SET AMHBHALL=1
- +3 IF 'AMHBHALL
- IF $SELECT(AMHGROUP:$PIECE(^AMHGROUP(AMHVIEN,0),U,15)'=DUZ,1:$PIECE(^AMHREC(AMHVIEN,0),U,19)'=DUZ)
- SET BGUV(BGUFILE,88888)=0
- Begin DoDot:1
- +4 IF AMHGROUP
- Begin DoDot:2
- +5 FOR
- SET BGUV(BGUFILE,88888)=$ORDER(^AMHGROUP(AMHVIEN,11,BGUV(BGUFILE,88888)))
- IF 'BGUV(BGUFILE,88888)
- QUIT
- IF $PIECE(^AMHGROUP(AMHVIEN,11,BGUV(BGUFILE,88888),0),U)=DUZ
- QUIT
- End DoDot:2
- QUIT
- +6 FOR
- SET BGUV(BGUFILE,88888)=$ORDER(^AMHRPROV("AD",AMHVIEN,BGUV(BGUFILE,88888)))
- IF 'BGUV(BGUFILE,88888)
- QUIT
- IF $PIECE(^AMHRPROV(BGUV(BGUFILE,88888),0),U)=DUZ
- QUIT
- End DoDot:1
- IF 'BGUV(BGUFILE,88888)
- QUIT
- +7 Begin DoDot:1
- +8 ;PICKUP ALL THESE FIELDS IF AMHSETLV IS SET, INSTEAD OF REQUIRING THEIR OWN FLAGS
- IF 'AMHGROUP
- IF AMHSETLV
- Begin DoDot:2
- +9 SET BGUV(BGUFILE,666666)=$ORDER(^AMHREDU("AD",AMHVIEN,0))
- +10 SET BGUV(BGUFILE,777777)=$ORDER(^AMHRHF("AD",AMHVIEN,0))
- +11 SET BGUV(BGUFILE,99999)=$ORDER(^AMHRPRO("AD",AMHVIEN,0))
- +12 SET BGUV(BGUFILE,88888)=0
- Begin DoDot:3
- +13 FOR
- SET BGUV(BGUFILE,88888)=$ORDER(^AMHRPROV("AD",AMHVIEN,BGUV(BGUFILE,88888)))
- IF BGUV(BGUFILE,88888)=""
- QUIT
- IF $PIECE(^AMHRPROV(BGUV(BGUFILE,88888),0),U,4)="P"
- QUIT
- End DoDot:3
- End DoDot:2
- QUIT
- +14 IF AMHSETLV
- Begin DoDot:2
- +15 SET BGUV(BGUFILE,99999)=$ORDER(^AMHGROUP(AMHVIEN,21,0))
- IF BGUV(BGUFILE,99999)
- SET BGUV(BGUFILE,99999)=$PIECE(^(BGUV(BGUFILE,99999),0),U)
- +16 SET BGUV(BGUFILE,88888)=0
- Begin DoDot:3
- End DoDot:3
- +17 FOR
- SET BGUV(BGUFILE,88888)=$ORDER(^AMHGROUP(AMHVIEN,11,BGUV(BGUFILE,88888)))
- IF 'BGUV(BGUFILE,88888)
- QUIT
- IF $PIECE(^AMHGROUP(AMHVIEN,11,BGUV(BGUFILE,88888),0),U,2)="P"
- SET BGUV(BGUFILE,88888)=$PIECE(^(0),U)
- QUIT
- End DoDot:2
- End DoDot:1
- +18 IF AMHSBJGR=""
- SET BGUSUB(1)=AMHVIEN
- SET BGUV(BGUFILE,.0001)=AMHX
- DO FIELDS^BGULIST
- SET AMHC=BGUICNT
- QUIT
- +19 SET AMHSIEN=0
- FOR
- SET AMHSIEN=$ORDER(@AMHSBJGR@(AMHSIEN))
- IF 'AMHSIEN
- QUIT
- SET AMHC=AMHC+1
- SET BGUSUB(1)=AMHSIEN
- SET BGUV(BGUFILE,.0001)=AMHX
- DO FIELDS^BGULIST
- SET AMHC=BGUICNT
- +20 QUIT
- +21 ;
- ADM ; Get Administration Entries
- +1 SET AMHCTYPE=$ORDER(^AMHTSET("B","ADMINISTRATIVE",""))
- AD ; Get AD xref entries
- +1 SET AMHBHALL=1
- SET AMHGREF="^AMHREC(""B"")"
- SET AMHVTYPE=1
- +2 DO MHREC
- +3 QUIT
- +4 ;
- MHCASE ;
- +1 SET AMHGREF="^AMHPCASE(""C"",AMHPIEN)"
- SET AMHDTCK="MHCASE1"
- +2 DO MHRC
- +3 QUIT
- +4 ;
- MHCASE1 ;
- +1 SET AMHVIEN=0
- FOR
- SET AMHVIEN=$ORDER(@AMHGREF@(AMHVIEN))
- IF 'AMHVIEN
- QUIT
- IF AMHC=AMHLIM
- QUIT
- SET AMHX=$PIECE(^AMHPCASE(AMHVIEN,0),U,1)
- IF AMHX'<AMHSDAT
- IF AMHX'>AMHEDAT
- DO MHENCTR
- +2 QUIT
- +3 ;
- MHTREAT ;
- +1 SET AMHGREF="^AMHPTXP(""AC"",AMHPIEN)"
- SET AMHDTCK="MHTREAT1"
- SET AMHSETLV=""
- +2 DO MHRC
- +3 QUIT
- +4 ;
- MHTREAT1 ;
- +1 SET AMHVIEN=0
- FOR
- SET AMHVIEN=$ORDER(@AMHGREF@(AMHVIEN))
- IF 'AMHVIEN
- QUIT
- IF AMHC=AMHLIM
- QUIT
- SET AMHX=$PIECE(^AMHPTXP(AMHVIEN,0),U,1)
- IF AMHX'<AMHSDAT
- IF AMHX'>AMHEDAT
- DO MHENCTR
- +2 QUIT
- +3 ;
- MHSUIV ;
- +1 SET AMHGREF="^AMHPSUIC(""AD"")"
- SET AMHSETLV=""
- +2 DO MHREC
- +3 QUIT
- +4 ;
- MHSUI ;
- +1 SET AMHGREF="^AMHPSUIC(""AC"",AMHPIEN)"
- SET AMHDTCK="MHSUI1"
- SET AMHSETLV=""
- +2 DO MHRC
- +3 QUIT
- +4 ;
- MHSUI1 ;
- +1 SET AMHVIEN=0
- FOR
- SET AMHVIEN=$ORDER(@AMHGREF@(AMHVIEN))
- IF 'AMHVIEN
- QUIT
- IF AMHC=AMHLIM
- QUIT
- SET AMHX=$PIECE(^AMHPSUIC(AMHVIEN,0),U,6)
- IF AMHX'<AMHSDAT
- IF AMHX'>AMHEDAT
- DO MHENCTR
- +2 QUIT
- +3 ;
- HF ; Health Factors
- +1 SET AMHSBJGR="^AMHRHF(""AD"",AMHVIEN)"
- SET AMHSETLV=0
- SET AMHCTYPE=""
- +2 DO MHENC
- +3 QUIT
- +4 ;
- EDU ; Patient Education
- +1 SET AMHSBJGR="^AMHREDU(""AD"",AMHVIEN)"
- SET AMHSETLV=0
- SET AMHCTYPE=""
- +2 DO MHENC
- +3 QUIT
- +4 ;
- MHGRP ;
- +1 SET AMHGREF="^AMHGROUP(""B"")"
- SET AMHGROUP=1
- SET AMHVTYPE=1
- +2 DO MHREC
- +3 QUIT
- +4 ;
- KILL ;
- +1 KILL BGUDRIVR,AMHC,AMHCTYPE,AMHDIVAL,AMHDTCK,AMHEDATE,AMHGREF,AMHGROUP,AMHBHALL,AMHLBONL,AMHLIM,AMHPIEN,AMHSBJGR,AMHSDATE,AMHSETLV,AMHSIEN,AMHVIEN,AMHVTYPE,AMHVWNO,AMHVWOPT,AMHX,AMHXX
- +2 QUIT
