AMHSC1.m

AMHSC1 ; IHS/CMI/LAB - SPECIAL X-REF ROUTINES - ;

 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010

 ;

 ; BGUBEGIN contains the Patient IEN

 ; BGUEND contains the following separated by "`"

 ;  1. Start Date (External format)

 ;  2. End Date (External format)

 ;  3. No of visits to view (ignored if View Option = 1)

 ;  4. Visits with labs only flag (0=No,1=Yes)

 ;  5. View Option (0=Last # of visits in dt rng,1=all visits in dt rng)

 ;

MED I '$D(BGUDRIVR) D  Q

 .S BGUDRIVR="MED^AMHSC1",BGUCRFS="",AMHPIEN=BGUBEGIN

 .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:32000)

 .S (BGUBEGIN,BGUEND)=""

 Q:AMHPIEN=""

 S AMHVWOPT="2"

 D MED1

 Q

 ;

MED1 ;

 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 D

 .S AMHSDATE="1/1/1980"

 .D DT^DILF("",AMHSDATE,.AMHSDAT)

 D DT^DILF("",AMHEDATE,.AMHEDAT)

 I AMHEDAT=-1 D

 .S AMHEDATE="T"

 .D DT^DILF("",AMHEDATE,.AMHEDAT)

 S AMHC=0,AMHX=0,AMHLIM=$S(AMHVWOPT="0":AMHVWNO,1:99999)

 F  S AMHX=$O(^AUPNVSIT("AA",AMHPIEN,AMHX)) Q:AMHX=""  D  Q:AMHC=AMHLIM

 .S AMHVIEN=""

 .F  S AMHVIEN=$O(^AUPNVSIT("AA",AMHPIEN,AMHX,AMHVIEN)) Q:AMHVIEN=""  D  Q:AMHC=AMHLIM

 ..S AMHDTA=^AUPNVSIT(AMHVIEN,0),AMHCKD=$P($P(AMHDTA,U,1),".",1)

 ..Q:AMHCKD=""!(AMHCKD<AMHSDAT)!(AMHCKD>AMHEDAT)

 ..S AMHC=AMHC+1,AMHPMIEN=0

 ..F  S AMHPMIEN=$O(^AUPNVMED("AD",AMHVIEN,AMHPMIEN)) Q:AMHPMIEN=""  D

 ...S AMHSTAT=-1

 ...I $D(^PSRX("APCC",AMHPMIEN)) D

 ....S AMHRXIEN=$O(^PSRX("APCC",AMHPMIEN,"")) Q:AMHRXIEN=""

 ....S AMHCK=$O(^PSRX("APCC",AMHPMIEN,AMHRXIEN,""))

 ....I AMHCK'="" S AMHSTAT=-1 Q

 ....S AMHSTAT=$P(^PSRX(AMHRXIEN,0),"^",15) S:AMHSTAT="" AMHSTAT=-1

 ....;I AMHSTAT=0 D MED2

 ...I AMHSTAT=0 S BGUSUB(1)=AMHPMIEN D FIELDS^BGULIST

 Q

MED2 ;

 N DYS,RFLS,ISUDAT,CKDT

 S AMHSTAT=-1,AMHRX0=$G(^PSRX(AMHRXIEN,0)) Q:AMHRX0=""

 S AMHRX2=$G(^PSRX(AMHRXIEN,2))

 S DYS=$P(AMHRX0,U,8),RFLS=$P(AMHRX0,U,9),ISUDAT=$P(AMHRX0,U,13)

 S X2=DYS*RFLS,X2=$S(DYS=X2:X2,X2<181:184,X2=360:366,1:X2)

 D:ISUDAT'=""

 .S X1=ISUDAT D C^%DTC S CKDT=$P(X,".",1)

 .S X="T" D ^%DT I CKDT'<Y S AMHSTAT=0

 Q

POV ; Get purpose of visits

 ;

 I '$D(BGUDRIVR) D  Q

 .S BGUDRIVR="POV^AMHSC1",BGUCRFS="",AMHPIEN=BGUBEGIN

 .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:32000)

 .S (BGUBEGIN,BGUEND)=""

 Q:AMHPIEN=""

 S AMHVWOPT="2"

 D POV1

 Q

POV1 ;

 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 D

 .S AMHSDATE="1/1/1980"

 .D DT^DILF("",AMHSDATE,.AMHSDAT)

 D DT^DILF("",AMHEDATE,.AMHEDAT)

 I AMHEDAT=-1 D

 .S AMHEDATE="T"

 .D DT^DILF("",AMHEDATE,.AMHEDAT)

 S AMHC=0,AMHX=0,AMHLIM=$S(AMHVWOPT="0":AMHVWNO,1:99999)

 F  S AMHX=$O(^AUPNVSIT("AA",AMHPIEN,AMHX)) Q:AMHX=""  D  Q:AMHC=AMHLIM

 .S AMHVIEN=""

 .F  S AMHVIEN=$O(^AUPNVSIT("AA",AMHPIEN,AMHX,AMHVIEN)) Q:AMHVIEN=""  D  Q:AMHC=AMHLIM

 ..S AMHDTA=^AUPNVSIT(AMHVIEN,0),AMHCKD=$P($P(AMHDTA,U,1),".",1)

 ..Q:AMHCKD=""!(AMHCKD<AMHSDAT)!(AMHCKD>AMHEDAT)

 ..S AMHC=AMHC+1,AMHPVIEN=0

 ..F  S AMHPVIEN=$O(^AUPNVPOV("AD",AMHVIEN,AMHPVIEN)) Q:AMHPVIEN=""  D

 ...S BGUSUB(1)=AMHPVIEN D FIELDS^BGULIST

 Q

MEAS ;

 I '$D(BGUDRIVR) D  Q

 .S BGUDRIVR="MEAS^AMHSC1",BGUCRFS="",AMHPIEN=BGUBEGIN

 .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:32000)

 .S (BGUBEGIN,BGUEND)=""

 Q:AMHPIEN=""

 S AMHVWOPT="2"

 D MEAS1

 Q

MEAS1 ;

 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 D

 .S AMHSDATE="1/1/1980"

 .D DT^DILF("",AMHSDATE,.AMHSDAT)

 D DT^DILF("",AMHEDATE,.AMHEDAT)

 I AMHEDAT=-1 D

 .S AMHEDATE="T"

 .D DT^DILF("",AMHEDATE,.AMHEDAT)

 S AMHC=0,AMHX=0,AMHLIM=$S(AMHVWOPT="0":AMHVWNO,1:99999)

 F  S AMHX=$O(^AUPNVSIT("AA",AMHPIEN,AMHX)) Q:AMHX=""  D  Q:AMHC=AMHLIM

 .S AMHVIEN=""

 .F  S AMHVIEN=$O(^AUPNVSIT("AA",AMHPIEN,AMHX,AMHVIEN)) Q:AMHVIEN=""  D  Q:AMHC=AMHLIM

 ..S AMHDTA=^AUPNVSIT(AMHVIEN,0),AMHCKD=$P($P(AMHDTA,U,1),".",1)

 ..Q:AMHCKD=""!(AMHCKD<AMHSDAT)!(AMHCKD>AMHEDAT)

 ..;Q:'$D(^AUPNVMSR("AD",AMHVIEN))

 ..S AMHC=AMHC+1,AMHMVIEN=0

 ..F  S AMHMVIEN=$O(^AUPNVMSR("AD",AMHVIEN,AMHMVIEN)) Q:AMHMVIEN=""  D

 ...S BGUSUB(1)=AMHMVIEN D FIELDS^BGULIST

 Q

EDP ; Get EDUCATION PROTOCOLS

 ;

 I '$D(BGUDRIVR) D  Q

 .S BGUDRIVR="EDP^AMHSC1",BGUCRFS="",AMHPIEN=BGUBEGIN

 .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:32000)

 .S (BGUBEGIN,BGUEND)=""

 Q:AMHPIEN=""

 S AMHVWOPT="2"

 D EDP1

 Q

EDP1 ;

 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 D

 .S AMHSDATE="1/1/1980"

 .D DT^DILF("",AMHSDATE,.AMHSDAT)

 D DT^DILF("",AMHEDATE,.AMHEDAT)

 I AMHEDAT=-1 D

 .S AMHEDATE="T"

 .D DT^DILF("",AMHEDATE,.AMHEDAT)

 S AMHC=0,AMHX=0,AMHLIM=$S(AMHVWOPT="0":AMHVWNO,1:99999)

 F  S AMHX=$O(^AUPNVSIT("AA",AMHPIEN,AMHX)) Q:'AMHX  D  Q:AMHC=AMHLIM

 .S AMHVIEN=""

 .F  S AMHVIEN=$O(^AUPNVSIT("AA",AMHPIEN,AMHX,AMHVIEN)) Q:'AMHVIEN  D  Q:AMHC=AMHLIM

 ..S AMHDTA=^AUPNVSIT(AMHVIEN,0),AMHCKD=$P($P(AMHDTA,U,1),".",1)

 ..Q:AMHCKD=""!(AMHCKD<AMHSDAT)!(AMHCKD>AMHEDAT)

 ..S AMHC=AMHC+1,AMHPVIEN=0

 ..F  S AMHPVIEN=$O(^AUPNVPED("AD",AMHVIEN,AMHPVIEN)) Q:'AMHPVIEN  D

 ...S BGUSUB(1)=AMHPVIEN D FIELDS^BGULIST

 Q

RAD ; Get RADIOLOGY PCC data

 ;

 I '$D(BGUDRIVR) D  Q

 .S BGUDRIVR="RAD^AMHSC1",BGUCRFS="",AMHPIEN=BGUBEGIN

 .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:32000)

 .S (BGUBEGIN,BGUEND)=""

 Q:AMHPIEN=""

 S AMHVWOPT="2"

 D RAD1

 Q

RAD1 ;

 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 D

 .S AMHSDATE="1/1/1980"

 .D DT^DILF("",AMHSDATE,.AMHSDAT)

 D DT^DILF("",AMHEDATE,.AMHEDAT)

 I AMHEDAT=-1 D

 .S AMHEDATE="T"

 .D DT^DILF("",AMHEDATE,.AMHEDAT)

 S AMHC=0,AMHX=0,AMHLIM=$S(AMHVWOPT="0":AMHVWNO,1:99999)

 F  S AMHX=$O(^AUPNVSIT("AA",AMHPIEN,AMHX)) Q:'AMHX  D  Q:AMHC=AMHLIM

 .S AMHVIEN=""

 .F  S AMHVIEN=$O(^AUPNVSIT("AA",AMHPIEN,AMHX,AMHVIEN)) Q:'AMHVIEN  D  Q:AMHC=AMHLIM

 ..S AMHDTA=^AUPNVSIT(AMHVIEN,0),AMHCKD=$P($P(AMHDTA,U,1),".",1)

 ..Q:AMHCKD=""!(AMHCKD<AMHSDAT)!(AMHCKD>AMHEDAT)

 ..S AMHC=AMHC+1,AMHPVIEN=0

 ..F  S AMHPVIEN=$O(^AUPNVRAD("AD",AMHVIEN,AMHPVIEN)) Q:'AMHPVIEN  D

 ...S BGUSUB(1)=AMHPVIEN D FIELDS^BGULIST

 Q

MIC ; Get V MICROBIOLOGY data

 ;

 K ^TMP($J)

 I '$D(BGUDRIVR) D  Q

 .S BGUDRIVR="MIC^AMHSC1",BGUCRFS="",AMHPIEN=BGUBEGIN

 .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:32000)

 .S (BGUBEGIN,BGUEND)=""

 Q:AMHPIEN=""

 S AMHVWOPT="2"

 D MIC1

 Q

MIC1 ;

 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 D

 .S AMHSDATE="1/1/1980"

 .D DT^DILF("",AMHSDATE,.AMHSDAT)

 D DT^DILF("",AMHEDATE,.AMHEDAT)

 I AMHEDAT=-1 D

 .S AMHEDATE="T"

 .D DT^DILF("",AMHEDATE,.AMHEDAT)

 S AMHC=0,AMHX=0,AMHLIM=$S(AMHVWOPT="0":AMHVWNO,1:99999)

 F  S AMHX=$O(^AUPNVSIT("AA",AMHPIEN,AMHX)) Q:'AMHX  D  Q:AMHC=AMHLIM

 .S AMHVIEN=""

 .F  S AMHVIEN=$O(^AUPNVSIT("AA",AMHPIEN,AMHX,AMHVIEN)) Q:'AMHVIEN  D  Q:AMHC=AMHLIM

 ..S AMHDTA=^AUPNVSIT(AMHVIEN,0),AMHCKD=$P($P(AMHDTA,U,1),".",1)

 ..Q:AMHCKD=""!(AMHCKD<AMHSDAT)!(AMHCKD>AMHEDAT)

 ..S AMHC=AMHC+1,AMHPVIEN=0

 ..F  S AMHPVIEN=$O(^AUPNVMIC("AD",AMHVIEN,AMHPVIEN)) Q:'AMHPVIEN  D

 ...D MIC2

 S AMHJ=$J,AMHMI="MICRO",AMHU=",",AMHZ=")",AMHQ=$C(34) S AMHX="^TMP("_AMHJ_AMHU_AMHQ_AMHMI_AMHQ_AMHZ

 F  S AMHX=$Q(@AMHX) Q:AMHX'[("^TMP("_AMHJ_AMHU_AMHQ_AMHMI_AMHQ_AMHU)  S AMHPVIEN=@AMHX S BGUSUB(1)=AMHPVIEN D FIELDS^BGULIST

 Q

MIC2 ;SORT BY PARENT

 S AMHPARNT=$S($P($G(^AUPNVMIC(AMHPVIEN,12)),U,8)>0:$P($G(^AUPNVMIC(AMHPVIEN,12)),U,8),1:0)

 S AMHACCN=$S($L($P($G(^AUPNVMIC(AMHPVIEN,0)),U,6))>0:$P($G(^AUPNVMIC(AMHPVIEN,0)),U,6),1:0)

 S AMHORGSM=$S($P($G(^AUPNVMIC(AMHPVIEN,0)),U,4)>0:$P($G(^AUPNVMIC(AMHPVIEN,0)),U,4),1:0) S:AMHORGSM AMHORGSM=$P($G(^LAB(61.2,AMHORGSM,0)),U,1)

 S AMHANTIB=$S($P($G(^AUPNVMIC(AMHPVIEN,0)),U,5)>0:$P($G(^AUPNVMIC(AMHPVIEN,0)),U,5),1:0) S:AMHANTIB AMHANTIB=$P($G(^LAB(62.06,AMHANTIB,0)),U,1)

 S ^TMP($J,"MICRO",AMHVIEN,AMHACCN,AMHPARNT,AMHORGSM,AMHANTIB,AMHPVIEN)=AMHPVIEN

 Q

PCCMED ; Get PRESCRIPTION PCC DATA

 ;

 K ^TMP($J)

 I '$D(BGUDRIVR) D  Q

 .S BGUDRIVR="PCCMED^AMHSC1",BGUCRFS="",AMHPIEN=BGUBEGIN

 .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:32000)

 .S (BGUBEGIN,BGUEND)=""

 Q:AMHPIEN=""

 S AMHVWOPT="2"

 D PCCMED1

 Q

PCCMED1 ;

 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 D

 .S AMHSDATE="1/1/1980"

 .D DT^DILF("",AMHSDATE,.AMHSDAT)

 D DT^DILF("",AMHEDATE,.AMHEDAT)

 I AMHEDAT=-1 D

 .S AMHEDATE="T"

 .D DT^DILF("",AMHEDATE,.AMHEDAT)

 S AMHC=0,AMHX=0,AMHLIM=$S(AMHVWOPT="0":AMHVWNO,1:99999)

 F  S AMHX=$O(^AUPNVSIT("AA",AMHPIEN,AMHX)) Q:'AMHX  D  Q:AMHC=AMHLIM

 .S AMHVIEN=""

 .F  S AMHVIEN=$O(^AUPNVSIT("AA",AMHPIEN,AMHX,AMHVIEN)) Q:'AMHVIEN  D  Q:AMHC=AMHLIM

 ..S AMHDTA=^AUPNVSIT(AMHVIEN,0),AMHCKD=$P($P(AMHDTA,U,1),".",1)

 ..Q:AMHCKD=""!(AMHCKD<AMHSDAT)!(AMHCKD>AMHEDAT)

 ..S AMHC=AMHC+1,AMHPVIEN=0

 ..F  S AMHPVIEN=$O(^AUPNVMED("AD",AMHVIEN,AMHPVIEN)) Q:'AMHPVIEN  D

 ...D PCCMED2

 S AMHJ=$J,AMHPMED="PCCMED",AMHU=",",AMHZ=")",AMHQ=$C(34) S AMHX="^TMP("_AMHJ_AMHU_AMHQ_AMHPMED_AMHQ_AMHZ

 F  S AMHX=$Q(@AMHX) Q:AMHX'[("^TMP("_AMHJ_AMHU_AMHQ_AMHPMED_AMHQ_AMHU)  S AMHPVIEN=@AMHX S BGUSUB(1)=AMHPVIEN D FIELDS^BGULIST

 Q

PCCMED2 ;SORT BY INVERSE VISIT DATE

 S AMHIDT=$S(AMHCKD>2700000:9999999-AMHCKD,1:9999999)

 S AMHMED=$S($P($G(^AUPNVMED(AMHPVIEN,0)),U,1)>0:$P($G(^AUPNVMED(AMHPVIEN,0)),U,1),1:0) S:+AMHMED AMHMED=$P($G(^PSDRUG(AMHMED,0)),U,1) S:'AMHMED AMHMED=0

 S ^TMP($J,"PCCMED",AMHIDT,AMHVIEN,AMHMED,AMHPVIEN)=AMHPVIEN

 Q

MEDP I '$D(BGUDRIVR) D  Q

 .S BGUDRIVR="MEDP^AMHSC1",BGUCRFS="",AMHPIEN=BGUBEGIN

 .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:32000)

 .S (BGUBEGIN,BGUEND)=""

 Q:AMHPIEN=""

 S AMHVWOPT="2"

 D MEDP1

 Q

 ;

MEDP1 ;

 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 D

 .S AMHSDATE="1/1/1980"

 .D DT^DILF("",AMHSDATE,.AMHSDAT)

 D DT^DILF("",AMHEDATE,.AMHEDAT)

 I AMHEDAT=-1 D

 .S AMHEDATE="T"

 .D DT^DILF("",AMHEDATE,.AMHEDAT)

 S AMHC=0,AMHX=0,AMHLIM=$S(AMHVWOPT="0":AMHVWNO,1:99999)

 F  S AMHX=$O(^AUPNVSIT("AA",AMHPIEN,AMHX)) Q:AMHX=""  D  Q:AMHC=AMHLIM

 .S AMHVIEN=""

 .F  S AMHVIEN=$O(^AUPNVSIT("AA",AMHPIEN,AMHX,AMHVIEN)) Q:AMHVIEN=""  D  Q:AMHC=AMHLIM

 ..S AMHDTA=^AUPNVSIT(AMHVIEN,0),AMHCKD=$P($P(AMHDTA,U,1),".",1)

 ..Q:AMHCKD=""!(AMHCKD<AMHSDAT)!(AMHCKD>AMHEDAT)

 ..S AMHC=AMHC+1,AMHPMIEN=0

 ..F  S AMHPMIEN=$O(^AUPNVMED("AD",AMHVIEN,AMHPMIEN)) Q:AMHPMIEN=""  D

 ...S AMHSTAT=-1

 ...I $D(^PSRX("APCC",AMHPMIEN)) D

 ....S AMHRXIEN=$O(^PSRX("APCC",AMHPMIEN,"")) Q:AMHRXIEN=""

 ....S AMHCK=$O(^PSRX("APCC",AMHPMIEN,AMHRXIEN,""))

 ....I AMHCK'="" S AMHSTAT=-1 Q

 ....S AMHSTAT=$P(^PSRX(AMHRXIEN,0),"^",15) S:AMHSTAT="" AMHSTAT=-1

 ....;I AMHSTAT=0 D MEDP2

 ...I AMHSTAT=0 S BGUSUB(1)=AMHPMIEN D FIELDS^BGULIST

 Q

MEDP2 ;

 N DYS,RFLS,ISUDAT,CKDT

 S AMHSTAT=-1,AMHRX0=$G(^PSRX(AMHRXIEN,0)) Q:AMHRX0=""

 S AMHRX2=$G(^PSRX(AMHRXIEN,2))

 S DYS=$P(AMHRX0,U,8),RFLS=$P(AMHRX0,U,9),ISUDAT=$P(AMHRX0,U,13)

 S X2=DYS*RFLS,X2=$S(DYS=X2:X2,X2<181:184,X2=360:366,1:X2)

 D:ISUDAT'=""

 .S X1=ISUDAT D C^%DTC S CKDT=$P(X,".",1)

 .S X="T" D ^%DT I CKDT'<Y S AMHSTAT=0

 Q

PAT ; Get PATIENT Data

 ; Set BGUCRFS1 to the cross-reference to be used for lookup.

 ; If the file is not the same as the primary file, prefix BGUCRFS1

 ; with the file number or name followed by a semicolan and then the

 ; cross-reference node.

 ;

 S BGUCRFS1="B"

 I BGUBEGIN?9N S BGUCRFS1="VA PATIENT;SSN" Q

 I BGUBEGIN?1.6N S BGUCRFS1="PATIENT;D" Q

 I BGUBEGIN?1A4N S BGUCRFS1="VA PATIENT;BS5" Q

 I BGUBEGIN?1.2N1"/"1.2N1"/"2.4N S X=BGUBEGIN D ^%DT S (BGUBEGIN,BGUEND)=Y,BGUCRFS1="VA PATIENT;ADOB" Q

 Q

RXMED ; Get PRESCRIPTION RX DATA

 ;

 K ^TMP($J)

 I '$D(BGUDRIVR) D  Q

 .S BGUDRIVR="RXMED^AMHSC1",BGUCRFS="",AMHPIEN=BGUBEGIN

 .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:32000)

 .S (BGUBEGIN,BGUEND)=""

 Q:AMHPIEN=""

 S AMHVWOPT="2"

 D RXMED1

 Q

RXMED1 ;

 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 D

 .S AMHSDATE="1/1/1980"

 .D DT^DILF("",AMHSDATE,.AMHSDAT)

 D DT^DILF("",AMHEDATE,.AMHEDAT)

 I AMHEDAT=-1 D

 .S AMHEDATE="T"

 .D DT^DILF("",AMHEDATE,.AMHEDAT)

 S AMHC=0,AMHX=0,AMHLIM=$S(AMHVWOPT="0":AMHVWNO,1:99999)

 S ^FJBGU(1)=AMHPIEN

 F  S AMHX=$O(^PS(55,AMHPIEN,"P",AMHX)) Q:'AMHX  D  Q:AMHC=AMHLIM

 .S AMHVIEN=$P($G(^PS(55,AMHPIEN,"P",AMHX,0)),U,1) Q:+AMHVIEN=0

 .S ^FJBGU(1,AMHX)=AMHVIEN

 .S AMHRX0=$G(^PSRX(AMHVIEN,0))

 .S AMHRX2=$G(^PSRX(AMHVIEN,2))

 .S ^FJBGU(AMHVIEN)=AMHRX2

 .S AMHCKD=$P($P(AMHRX2,U,1),".",1)

 .Q:AMHCKD=""!(AMHCKD<AMHSDAT)!(AMHCKD>AMHEDAT)

 .S BGUSUB(1)=AMHVIEN D FIELDS^BGULIST

 Q

AMHSC1    ; IHS/CMI/LAB - SPECIAL X-REF ROUTINES - ;

 +1       ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010

 +2       ;

 +3       ; BGUBEGIN contains the Patient IEN

 +4       ; BGUEND contains the following separated by "`"

 +5       ;  1. Start Date (External format)

 +6       ;  2. End Date (External format)

 +7       ;  3. No of visits to view (ignored if View Option = 1)

 +8       ;  4. Visits with labs only flag (0=No,1=Yes)

 +9       ;  5. View Option (0=Last # of visits in dt rng,1=all visits in dt rng)

 +10      ;

MED        IF '$DATA(BGUDRIVR)

               Begin DoDot:1

 +1                SET BGUDRIVR="MED^AMHSC1"

                   SET BGUCRFS=""

                   SET AMHPIEN=BGUBEGIN

 +2                SET AMHSDATE=$PIECE(BGUEND,"`",1)

                   SET AMHEDATE=$PIECE(BGUEND,"`",2)

 +3                SET AMHVWNO=$PIECE(BGUEND,"`",3)

                   SET AMHLBONL=$PIECE(BGUEND,"`",4)

 +4                SET AMHVWOPT=$PIECE(BGUEND,"`",5)

                   SET BGUMAX=$SELECT('AMHVWOPT:AMHVWNO,1:32000)

 +5                SET (BGUBEGIN,BGUEND)=""

               End DoDot:1

               QUIT 

 +6        IF AMHPIEN=""

               QUIT 

 +7        SET AMHVWOPT="2"

 +8        DO MED1

 +9        QUIT 

 +10      ;

MED1      ;

 +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

               Begin DoDot:1

 +6                SET AMHSDATE="1/1/1980"

 +7                DO DT^DILF("",AMHSDATE,.AMHSDAT)

               End DoDot:1

 +8        DO DT^DILF("",AMHEDATE,.AMHEDAT)

 +9        IF AMHEDAT=-1

               Begin DoDot:1

 +10               SET AMHEDATE="T"

 +11               DO DT^DILF("",AMHEDATE,.AMHEDAT)

               End DoDot:1

 +12       SET AMHC=0

           SET AMHX=0

           SET AMHLIM=$SELECT(AMHVWOPT="0":AMHVWNO,1:99999)

 +13       FOR 

               SET AMHX=$ORDER(^AUPNVSIT("AA",AMHPIEN,AMHX))

               IF AMHX=""

                   QUIT 

               Begin DoDot:1

 +14               SET AMHVIEN=""

 +15               FOR 

                       SET AMHVIEN=$ORDER(^AUPNVSIT("AA",AMHPIEN,AMHX,AMHVIEN))

                       IF AMHVIEN=""

                           QUIT 

                       Begin DoDot:2

 +16                       SET AMHDTA=^AUPNVSIT(AMHVIEN,0)

                           SET AMHCKD=$PIECE($PIECE(AMHDTA,U,1),".",1)

 +17                       IF AMHCKD=""!(AMHCKD<AMHSDAT)!(AMHCKD>AMHEDAT)

                               QUIT 

 +18                       SET AMHC=AMHC+1

                           SET AMHPMIEN=0

 +19                       FOR 

                               SET AMHPMIEN=$ORDER(^AUPNVMED("AD",AMHVIEN,AMHPMIEN))

                               IF AMHPMIEN=""

                                   QUIT 

                               Begin DoDot:3

 +20                               SET AMHSTAT=-1

 +21                               IF $DATA(^PSRX("APCC",AMHPMIEN))

                                       Begin DoDot:4

 +22                                       SET AMHRXIEN=$ORDER(^PSRX("APCC",AMHPMIEN,""))

                                           IF AMHRXIEN=""

                                               QUIT 

 +23                                       SET AMHCK=$ORDER(^PSRX("APCC",AMHPMIEN,AMHRXIEN,""))

 +24                                       IF AMHCK'=""

                                               SET AMHSTAT=-1

                                               QUIT 

 +25                                       SET AMHSTAT=$PIECE(^PSRX(AMHRXIEN,0),"^",15)

                                           IF AMHSTAT=""

                                               SET AMHSTAT=-1

 +26      ;I AMHSTAT=0 D MED2

                                       End DoDot:4

 +27                               IF AMHSTAT=0

                                       SET BGUSUB(1)=AMHPMIEN

                                       DO FIELDS^BGULIST

                               End DoDot:3

                       End DoDot:2

                       IF AMHC=AMHLIM

                           QUIT 

               End DoDot:1

               IF AMHC=AMHLIM

                   QUIT 

 +28       QUIT 

MED2      ;

 +1        NEW DYS,RFLS,ISUDAT,CKDT

 +2        SET AMHSTAT=-1

           SET AMHRX0=$GET(^PSRX(AMHRXIEN,0))

           IF AMHRX0=""

               QUIT 

 +3        SET AMHRX2=$GET(^PSRX(AMHRXIEN,2))

 +4        SET DYS=$PIECE(AMHRX0,U,8)

           SET RFLS=$PIECE(AMHRX0,U,9)

           SET ISUDAT=$PIECE(AMHRX0,U,13)

 +5        SET X2=DYS*RFLS

           SET X2=$SELECT(DYS=X2:X2,X2<181:184,X2=360:366,1:X2)

 +6        IF ISUDAT'=""

               Begin DoDot:1

 +7                SET X1=ISUDAT

                   DO C^%DTC

                   SET CKDT=$PIECE(X,".",1)

 +8                SET X="T"

                   DO ^%DT

                   IF CKDT'<Y

                       SET AMHSTAT=0

               End DoDot:1

 +9        QUIT 

POV       ; Get purpose of visits

 +1       ;

 +2        IF '$DATA(BGUDRIVR)

               Begin DoDot:1

 +3                SET BGUDRIVR="POV^AMHSC1"

                   SET BGUCRFS=""

                   SET AMHPIEN=BGUBEGIN

 +4                SET AMHSDATE=$PIECE(BGUEND,"`",1)

                   SET AMHEDATE=$PIECE(BGUEND,"`",2)

 +5                SET AMHVWNO=$PIECE(BGUEND,"`",3)

                   SET AMHLBONL=$PIECE(BGUEND,"`",4)

 +6                SET AMHVWOPT=$PIECE(BGUEND,"`",5)

                   SET BGUMAX=$SELECT('AMHVWOPT:AMHVWNO,1:32000)

 +7                SET (BGUBEGIN,BGUEND)=""

               End DoDot:1

               QUIT 

 +8        IF AMHPIEN=""

               QUIT 

 +9        SET AMHVWOPT="2"

 +10       DO POV1

 +11       QUIT 

POV1      ;

 +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

               Begin DoDot:1

 +6                SET AMHSDATE="1/1/1980"

 +7                DO DT^DILF("",AMHSDATE,.AMHSDAT)

               End DoDot:1

 +8        DO DT^DILF("",AMHEDATE,.AMHEDAT)

 +9        IF AMHEDAT=-1

               Begin DoDot:1

 +10               SET AMHEDATE="T"

 +11               DO DT^DILF("",AMHEDATE,.AMHEDAT)

               End DoDot:1

 +12       SET AMHC=0

           SET AMHX=0

           SET AMHLIM=$SELECT(AMHVWOPT="0":AMHVWNO,1:99999)

 +13       FOR 

               SET AMHX=$ORDER(^AUPNVSIT("AA",AMHPIEN,AMHX))