AMHSC2.m

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