source: FOIAVistA/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSDSS.m@ 1314

YSDSS ;DALCIOFO/MJD-MENTAL HEALTH DSS EXTRACT ;05/19/99
 ;;5.01;MENTAL HEALTH;**56**;Dec 30, 1994
 Q
 ;
UPD(YSFILE,YSFRN,YSYRMO,YSEXTN,YSSITE,YSSD,YSEND,YSERR)  ;parameter list 
 ;
 ; YSFILE - MENTAL HEALTH EXTRACT file (#727.812) - constant
 ; YSFRN  - Last IEN of the MENTAL HEALTH EXTRACT file (#727.812)
 ; YSYRMO - YearMonth of the extract to which this record belongs
 ; YSEXTN - Identifies the specific extract to which this record belongs
 ; YSSITE - Facility number
 ; YSSD   - Start date for extract
 ; YSEND   - End date for extract
 ; YSERR  - for return of "1", if error condition; otherwise return "0";
 ;          passed by reference; if any parameter missing or incorrect 
 ;          format, then return "1"
 ;
 ;
 ; Check for DSS MH TESTS file (#727.5)
 I '$D(^ECX(727.5,0)) S YSERR=1 Q
 ; Check for YTAPI2 routine
 S X="YTAPI2" X ^%ZOSF("TEST") I '$T S YSERR=1 Q
 ;
 D PT
 D ASI
 D GAF
 Q
 ;
PT ; Retrieve the PSYCH INSTRUMENT PATIENT file (#601.2) data
 N YSD,YSD2,YSDFN,YSTSTN
 S YSDFN=0
 F  S YSDFN=$O(^YTD(601.2,YSDFN)) Q:YSDFN=""!('YSDFN)  D
 .Q:$$TEST(YSDFN)
 . S YSD=0
 . F  S YSD=$O(^YTD(601.2,YSDFN,1,YSD)) Q:'YSD  D
 .. S YSTSTN=$P($G(^YTT(601,+YSD,0)),U)
 .. Q:YSTSTN=""
 .. S YSD2=0
 .. F  S YSD2=$O(^YTD(601.2,YSDFN,1,YSD,1,YSD2)) Q:'YSD2  D
 ... Q:(YSD2<(YSSD))  Q:(YSD2>(YSEND+1)) 
 ... S YSDET=0 D CHKT
 ... I YSDET D
 .... S YS("DFN")=YSDFN
 .... S YS("CODE")=YSTSTN
 .... S YS("ADATE")=$$FMTE^XLFDT(YSD2,"2DZ")
 .... D SCOREIT^YTAPI2(.YSDATA,.YS)
 .... S YSPRV=$P(^YTD(601.2,YSDFN,1,YSD,1,YSD2,0),U,3)
 .... S YSSCOR=""
 .... S YSS=5
 .... F  S YSS=$O(YSDATA(YSS)) Q:YSS'>0  D
 ..... S YSSCNUM=$P(YSDATA(YSS),U)
 ..... S YSSCNAM=$P(YSDATA(YSS),U,2)
 ..... S YSSCSC=$P(YSDATA(YSS),U,3)
 ..... D CR
 ..... Q
 ... I 'YSDET D
 .... S (YSPRV,YSSCNUM,YSSCNAM,YSSCOR,YSSCSC)=""
 .... D CR
 .... Q
 ... Q
 .. Q
 .Q
 Q
 ;
CHKT ;
 N YS,YSACT,YSINACT
 S (YS,YSDET)=0,(YSACT,YSINACT)=""
 Q:'$D(^ECX(727.5,"B",YSTSTN))
 S YS=$O(^ECX(727.5,"B",YSTSTN,YS))
 Q:'$D(^ECX(727.5,YS,0))
 S YSACT=$O(^ECX(727.5,"AC",YS,9999999),-1)
 I $D(^ECX(727.5,"AX",YS)) S YSINACT=$O(^ECX(727.5,"AX",YS,9999999),-1)
 Q:YSACT>YSD2
 Q:YSINACT>YSACT
 S YSDET=1
 Q
 ;
CR ;Create a MENTAL HEALTH EXTRACT
 S YSFRN=YSFRN+1
 S ^ECX(YSFILE,YSFRN,0)=YSFRN_U_YSYRMO_U_YSEXTN_U_YSSITE_U_YSDFN
 S $P(^ECX(YSFILE,YSFRN,0),U,9)=YSD2
 S $P(^ECX(YSFILE,YSFRN,0),U,18)=YSPRV
 S $P(^ECX(YSFILE,YSFRN,0),U,21)=YSTSTN
 S $P(^ECX(YSFILE,YSFRN,0),U,22)=YSD
 S $P(^ECX(YSFILE,YSFRN,0),U,23)=YSSCNUM
 S $P(^ECX(YSFILE,YSFRN,0),U,24)=YSSCNAM
 S $P(^ECX(YSFILE,YSFRN,0),U,25)=YSSCOR
 S $P(^ECX(YSFILE,YSFRN,0),U,26)=YSSCSC
 QUIT
 ;
ASI ; ASI
 N YSDFN,YSIEN,YSASIDT
 S YSTSTN="ASI"
 S YSDFN=0
 F  S YSDFN=$O(^YSTX(604,"C",YSDFN)) Q:'YSDFN  D
 .Q:$$TEST(YSDFN)
 . S YSIEN=0
 . F  S YSIEN=$O(^YSTX(604,"C",YSDFN,YSIEN)) Q:'YSIEN  D
 .. Q:'$D(^YSTX(604,YSIEN,0))
 .. S YSASIDT=$P($P(^YSTX(604,YSIEN,0),"^",5),".",1)
 .. I (YSASIDT>(YSSD-1))&(YSASIDT<(YSEND+1)) D
 ... S YSDTOI=$P(^YSTX(604,YSIEN,0),U,5)
 ... S YSPRV=$P(^YSTX(604,YSIEN,0),U,9)
 ... S YS("DFN")=YSDFN
 ... S YS("CODE")="ASI"
 ... S YSCLAS=$P(^YSTX(604,YSIEN,0),U,4)
 ... S YSSPEC=$P(^YSTX(604,YSIEN,0),U,11)
 ... S YS("ADATE")=$$FMTE^XLFDT(YSASIDT,"2DZ")
 ... D SCOREIT^YTAPI2(.YSDATA,.YS)
 ... F YSS=6:1 Q:YSS>12  D CRASI
 ... Q
 .. Q
 . Q
 Q
 ;
CRASI ;
 S YSFRN=YSFRN+1
 S YSSCNUM=$P(YSDATA(YSS),U)
 S YSSCNAM=$P(YSDATA(YSS),U,2)
 S YSSCSC=$TR($P(YSDATA(YSS),U,4)," ")
 S ^ECX(YSFILE,YSFRN,0)=YSFRN_U_YSYRMO_U_YSEXTN_U_YSSITE_U_YSDFN
 S $P(^ECX(YSFILE,YSFRN,0),U,9)=YSDTOI
 S $P(^ECX(YSFILE,YSFRN,0),U,18)=YSPRV
 S $P(^ECX(YSFILE,YSFRN,0),U,21)=YSTSTN
 S $P(^ECX(YSFILE,YSFRN,0),U,23)=YSSCNUM
 S $P(^ECX(YSFILE,YSFRN,0),U,24)=YSSCNAM
 S $P(^ECX(YSFILE,YSFRN,0),U,26)=YSSCSC
 S ^ECX(YSFILE,YSFRN,1)=""
 S $P(^ECX(YSFILE,YSFRN,1),U,5)=YSCLAS
 S $P(^ECX(YSFILE,YSFRN,1),U,6)=YSSPEC
 QUIT
 ;
GAF ; GAF
 N YSIEN
 S YSIEN=0
 F  S YSIEN=$O(^YSD(627.8,YSIEN)) Q:YSIEN=""!('YSIEN)  D
 . Q:'$D(^YSD(627.8,YSIEN,0))
 . S YSGFDATE=$P($P(^YSD(627.8,YSIEN,0),"^",3),".",1)
 . I (YSGFDATE>(YSSD-1))&(YSGFDATE<(YSEND+1)) D
 .. I $P($G(^YSD(627.8,YSIEN,60)),U,3)="" Q
 .. S YSDFN=$P(^YSD(627.8,YSIEN,0),U,2)
 .. Q:$$TEST(YSDFN)
 .. S YSFRN=YSFRN+1
 .. S YSPRV=$P(^YSD(627.8,YSIEN,0),U,4)
 .. S YSTSTN="GAF"
 .. S YSSCOR=$P($G(^YSD(627.8,YSIEN,60)),U,3)
 .. S ^ECX(YSFILE,YSFRN,0)=YSFRN_U_YSYRMO_U_YSEXTN_U_YSSITE_U_YSDFN
 .. S $P(^ECX(YSFILE,YSFRN,0),U,9)=YSGFDATE
 .. S $P(^ECX(YSFILE,YSFRN,0),U,18)=YSPRV
 .. S $P(^ECX(YSFILE,YSFRN,0),U,21)=YSTSTN
 .. S $P(^ECX(YSFILE,YSFRN,0),U,25)=YSSCOR
 .. Q
 . Q
 QUIT
 ;
TEST(YSDFN) ;is this a test patient?
 N ARR,SSN
 S DA=YSDFN,DIC="^DPT(",DIQ(0)="I",DR=".09",DIQ="ARR"
 D EN^DIQ1
 S SSN=ARR(2,YSDFN,.09,"I")
 I $E(SSN,1,5)="00000" Q 1
 Q 0