source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTQAPI13.m@ 1608

YTQAPI13        ;ASF/ALB MHQ EXPORT PROCEEDURES ; 4/3/07 11:21am
        ;;5.01;MENTAL HEALTH;**85**;Dec 30, 1994;Build 49
        Q
EXPORT(YSDATA,YS)       ;export instrument
        N %X,%Y,G,I,N,N1,N2,YSCALE,YSCI,YSCNT,YSDI,YSEQ,YSERR,YSFILE,YSKEY,YSN,YSNAM,YSNUM,YSQ,YSQN,YSR,YSCT
        K ^TMP($J,"YSE"),^TMP($J,"YSQ")
        S YSCNT=0
        S YSERR=0
        D PARSE Q:YSERR  ; set/check inputs
        S YSFILE=601.71 D SET(YSNUM) ; test entry
        D CONTENT ;inst content
        D QUES ;questions
        D INTRO
        D DISPLAY ; q<i>c displays
        D CHOICE ;types & choices
        D SKIP ;skipped questions
        D RULES ;instrument rules and rules
        D SECTION
        D SCALES ;scale grps,scales,keys
        D MAIL ;export mailman
        Q
CHOICE  ;
        ;choice type
        S YSQ=0 F  S YSQ=$O(^TMP($J,"YSQ",YSQ)) Q:YSQ=""  D
        . S YSCT=$P($G(^YTT(601.72,YSQ,2)),U,3)
        . Q:YSCT'?1N.N
        . S ^TMP($J,"YSCT",YSCT)=""
        . S YSFILE=601.751 D SET(YSCT)
        S YSCT=0 F  S YSCT=$O(^TMP($J,"YSCT",YSCT)) Q:YSCT'>0  D
        . S YSCI=$P($G(^YTT(601.751,0)),U,3)
        . S YSFILE=601.75 D:YSCI?1N.N SET(YSCI)
        Q
SCALES  ;
        ;scale grp
        S YSFILE=601.86
        S YSN=0 F  S N=$O(^YTT(601.86,"AD",YSNUM,YSN)) Q:YSN'>0  D
        . S YSFILE=601.86 D SET(YSN)
        . ;scales
        . S YSCALE=0 F  S YSCALE=$O(^YTT(601.87,"AD",YSN,YSCALE)) Q:YSCALE'>0  D
        .. S YSFILE=601.87 D SET(YSCALE)
        .. S YSKEY=0 F  S YSKEY=$O(^YTT(601.91,"AC",YSCALE,YSKEY)) Q:YSKEY'>0  S YSFILE=601.91 D SET(YSKEY)
        Q
RULES   ;ins rules-rules
        S YSFILE=601.83
        S YSN=0 F  S YSN=$O(^YTT(601.83,"C",YSNUM,YSN)) Q:YSN'>0  D
        . D SET(YSN)
        S YSFILE=601.82
        S YSN=0 F  S YSN=$O(^YTT(601.83,"C",YSNUM,YSN)) Q:YSN'>0  D
        . S YSR=$P($G(^YTT(601.83,YSN,0)),U,4)
        . D:YSR?1N.N SET(YSN)
        Q
SECTION ;headings
        S YSFILE=601.81
        S YSN=0 F  S YSN=$O(^YTT(601.81,"AC",YSNUM,YSN)) Q:YSN'>0  D
        . D SET(YSN)
        Q
SKIP    ;skipped qs
        S YSFILE=601.79
        S YSN=0 F  S YSN=$O(^YTT(601.79,"AC",YSNUM,YSN)) Q:YSN'>0  D
        . D SET(YSN)
        Q
DISPLAY ;display ques<intro<choice
        S YSFILE=601.88
        S YSN=0 F  S YSN=$O(^YTT(601.76,"AC",YSNUM,YSN)) Q:YSN'>0  D
        . S G=$G(^YTT(601.76,YSN,0))
        . F I=7,8,9 S YSDI=$P(G,U,I) D:YSDI?1N.N SET(YSDI)
        Q
CONTENT ;
        S YSFILE=601.76
        S YSEQ=0 F  S YSEQ=$O(^YTT(601.76,"AD",YSNUM,YSEQ)) Q:YSEQ'>0  S YSN=0 F  S YSN=$O(^YTT(601.76,"AD",YSNUM,YSEQ,YSN)) Q:YSN'>0  D
        . D SET(YSN)
        Q
QUES    ;questions
        S YSFILE=601.72
        S YSEQ=0 F  S YSEQ=$O(^YTT(601.76,"AD",YSNUM,YSEQ)) Q:YSEQ'>0  S YSN=0 F  S YSN=$O(^YTT(601.76,"AD",YSNUM,YSEQ,YSN)) Q:YSN'>0  D
        . S YSQN=$P(^YTT(601.76,YSN,0),U,4)
        . S ^TMP($J,"YSQ",YSQN)=""
        . D SET(YSQN)
        Q
INTRO   ;intros
        S YSFILE=601.73
        S YSQN=0 F  S YSQN=$O(^TMP($J,"YSQ",YSQN)) Q:YSQN'>0  D
        . S YSN=$P($G(^YTT(601.72,YSQN,2)),U)
        . D:YSN>0 SET(YSN)
        Q
PARSE   ;get old name, new name and national
        S YSERR=1,YSDATA(1)="[ERROR]"
        S YSNAM=$G(YS("CODE"))
        I YSNAM="" S YSDATA(2)="no code" Q  ;-->out
        I '$D(^YTT(601.71,"B",YSNAM)) S YSDATA(2)="bad code" Q  ;--->out
        S YSNUM=$O(^YTT(601.71,"B",YSNAM,0)),YSDATA(1)="[DATA]",YSERR=0
        Q
MAIL    ;Mailman
        N XMSUB,XMTEXT,XMDUZ,XMY
        S XMSUB="Export of "_YS("CODE")
        S XMTEXT="^TMP($J,""YSE"","
        S XMY(DUZ)=""
        S XMDUZ="AUTOMATED MESSAGE"
        D ^XMD
        Q
SET(YSIEN)      ;content set
        S N=-1 F  S N=$O(^YTT(YSFILE,YSIEN,N)) Q:N=""  D G1
        Q
G1      D:$D(^YTT(YSFILE,YSIEN,N))#2  S N1=-1 F  S N1=$O(^YTT(YSFILE,YSIEN,N,N1)) Q:N1=""  D G2
        . S YSCNT=YSCNT+1
        . S ^TMP($J,"YSE",YSCNT)="^TMP($J,""YSI"","_YSFILE_","_YSIEN_","_N_")"
        . S YSCNT=YSCNT+1
        . S ^TMP($J,"YSE",YSCNT)=^YTT(YSFILE,YSIEN,N)
        Q
G2      D:$D(^YTT(YSFILE,YSIEN,N,N1))#2  S N2=-1 F  S N2=$O(^YTT(YSFILE,YSIEN,N,N1,N2)) Q:N2=""  D G3
        . S YSCNT=YSCNT+1
        . S ^TMP($J,"YSE",YSCNT)="^TMP($J,""YSI"","_YSFILE_","_YSIEN_","_N_","_N1_")"
        . S YSCNT=YSCNT+1
        . S ^TMP($J,"YSE",YSCNT)=^YTT(YSFILE,YSIEN,N,N1)
        Q
G3      D:$D(^YTT(YSFILE,YSIEN,N,N1,N2))#2
        . S YSCNT=YSCNT+1
        . S ^TMP($J,"YSE",YSCNT)="^TMP($J,""YSI"","_YSFILE_","_YSIEN_","_N_","_N1_","_N2_")"
        . S YSCNT=YSCNT+1
        . S ^TMP($J,"YSE",YSCNT)=^YTT(YSFILE,YSIEN,N,N1,N2)
        Q