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
