YTQAPI13.m

YTQAPI13 ;ASF/ALB MHQ EXPORT PROCEEDURES ; 4/3/07 11:21am

 ;;5.01;MENTAL HEALTH;**85**;Dec 30, 1994;Build 48

 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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---YTQAPI13   3941     printed  Mar 13, 2025@21:23                                                                                                                                                                                                       Page 2

YTQAPI13  ;ASF/ALB MHQ EXPORT PROCEEDURES ; 4/3/07 11:21am

 +1       ;;5.01;MENTAL HEALTH;**85**;Dec 30, 1994;Build 48

 +2        QUIT 

EXPORT(YSDATA,YS) ;export instrument

 +1        NEW %X,%Y,G,I,N,N1,N2,YSCALE,YSCI,YSCNT,YSDI,YSEQ,YSERR,YSFILE,YSKEY,YSN,YSNAM,YSNUM,YSQ,YSQN,YSR,YSCT

 +2        KILL ^TMP($JOB,"YSE"),^TMP($JOB,"YSQ")

 +3        SET YSCNT=0

 +4        SET YSERR=0

 +5       ; set/check inputs

           DO PARSE

           if YSERR

               QUIT 

 +6       ; test entry

           SET YSFILE=601.71

           DO SET(YSNUM)

 +7       ;inst content

           DO CONTENT

 +8       ;questions

           DO QUES

 +9        DO INTRO

 +10      ; q<i>c displays

           DO DISPLAY

 +11      ;types & choices

           DO CHOICE

 +12      ;skipped questions

           DO SKIP

 +13      ;instrument rules and rules

           DO RULES

 +14       DO SECTION

 +15      ;scale grps,scales,keys

           DO SCALES

 +16      ;export mailman

           DO MAIL

 +17       QUIT 

CHOICE    ;

 +1       ;choice type

 +2        SET YSQ=0

           FOR 

               SET YSQ=$ORDER(^TMP($JOB,"YSQ",YSQ))

               if YSQ=""

                   QUIT 

               Begin DoDot:1

 +3                SET YSCT=$PIECE($GET(^YTT(601.72,YSQ,2)),U,3)

 +4                if YSCT'?1N.N

                       QUIT 

 +5                SET ^TMP($JOB,"YSCT",YSCT)=""

 +6                SET YSFILE=601.751

                   DO SET(YSCT)

               End DoDot:1

 +7        SET YSCT=0

           FOR 

               SET YSCT=$ORDER(^TMP($JOB,"YSCT",YSCT))

               if YSCT'>0

                   QUIT 

               Begin DoDot:1

 +8                SET YSCI=$PIECE($GET(^YTT(601.751,0)),U,3)

 +9                SET YSFILE=601.75

                   if YSCI?1N.N

                       DO SET(YSCI)

               End DoDot:1

 +10       QUIT 

SCALES    ;

 +1       ;scale grp

 +2        SET YSFILE=601.86

 +3        SET YSN=0

           FOR 

               SET N=$ORDER(^YTT(601.86,"AD",YSNUM,YSN))

               if YSN'>0

                   QUIT 

               Begin DoDot:1

 +4                SET YSFILE=601.86

                   DO SET(YSN)

 +5       ;scales

 +6                SET YSCALE=0

                   FOR 

                       SET YSCALE=$ORDER(^YTT(601.87,"AD",YSN,YSCALE))

                       if YSCALE'>0

                           QUIT 

                       Begin DoDot:2

 +7                        SET YSFILE=601.87

                           DO SET(YSCALE)

 +8                        SET YSKEY=0

                           FOR 

                               SET YSKEY=$ORDER(^YTT(601.91,"AC",YSCALE,YSKEY))

                               if YSKEY'>0

                                   QUIT 

                               SET YSFILE=601.91

                               DO SET(YSKEY)

                       End DoDot:2

               End DoDot:1

 +9        QUIT 

RULES     ;ins rules-rules

 +1        SET YSFILE=601.83

 +2        SET YSN=0

           FOR 

               SET YSN=$ORDER(^YTT(601.83,"C",YSNUM,YSN))

               if YSN'>0

                   QUIT 

               Begin DoDot:1

 +3                DO SET(YSN)

               End DoDot:1

 +4        SET YSFILE=601.82

 +5        SET YSN=0

           FOR 

               SET YSN=$ORDER(^YTT(601.83,"C",YSNUM,YSN))

               if YSN'>0

                   QUIT 

               Begin DoDot:1

 +6                SET YSR=$PIECE($GET(^YTT(601.83,YSN,0)),U,4)

 +7                if YSR?1N.N

                       DO SET(YSN)

               End DoDot:1

 +8        QUIT 

SECTION   ;headings

 +1        SET YSFILE=601.81

 +2        SET YSN=0

           FOR 

               SET YSN=$ORDER(^YTT(601.81,"AC",YSNUM,YSN))

               if YSN'>0

                   QUIT 

               Begin DoDot:1

 +3                DO SET(YSN)

               End DoDot:1

 +4        QUIT 

SKIP      ;skipped qs

 +1        SET YSFILE=601.79

 +2        SET YSN=0

           FOR 

               SET YSN=$ORDER(^YTT(601.79,"AC",YSNUM,YSN))

               if YSN'>0

                   QUIT 

               Begin DoDot:1

 +3                DO SET(YSN)

               End DoDot:1

 +4        QUIT 

DISPLAY   ;display ques<intro<choice

 +1        SET YSFILE=601.88

 +2        SET YSN=0

           FOR 

               SET YSN=$ORDER(^YTT(601.76,"AC",YSNUM,YSN))

               if YSN'>0

                   QUIT 

               Begin DoDot:1

 +3                SET G=$GET(^YTT(601.76,YSN,0))

 +4                FOR I=7,8,9

                       SET YSDI=$PIECE(G,U,I)

                       if YSDI?1N.N

                           DO SET(YSDI)

               End DoDot:1

 +5        QUIT 

CONTENT   ;

 +1        SET YSFILE=601.76

 +2        SET YSEQ=0

           FOR 

               SET YSEQ=$ORDER(^YTT(601.76,"AD",YSNUM,YSEQ))

               if YSEQ'>0

                   QUIT 

               SET YSN=0

               FOR 

                   SET YSN=$ORDER(^YTT(601.76,"AD",YSNUM,YSEQ,YSN))

                   if YSN'>0

                       QUIT 

                   Begin DoDot:1

 +3                    DO SET(YSN)

                   End DoDot:1

 +4        QUIT 

QUES      ;questions

 +1        SET YSFILE=601.72

 +2        SET YSEQ=0

           FOR 

               SET YSEQ=$ORDER(^YTT(601.76,"AD",YSNUM,YSEQ))

               if YSEQ'>0

                   QUIT 

               SET YSN=0

               FOR 

                   SET YSN=$ORDER(^YTT(601.76,"AD",YSNUM,YSEQ,YSN))

                   if YSN'>0

                       QUIT 

                   Begin DoDot:1

 +3                    SET YSQN=$PIECE(^YTT(601.76,YSN,0),U,4)

 +4                    SET ^TMP($JOB,"YSQ",YSQN)=""

 +5                    DO SET(YSQN)

                   End DoDot:1

 +6        QUIT 

INTRO     ;intros

 +1        SET YSFILE=601.73

 +2        SET YSQN=0

           FOR 

               SET YSQN=$ORDER(^TMP($JOB,"YSQ",YSQN))

               if YSQN'>0

                   QUIT 

               Begin DoDot:1

 +3                SET YSN=$PIECE($GET(^YTT(601.72,YSQN,2)),U)

 +4                if YSN>0

                       DO SET(YSN)

               End DoDot:1

 +5        QUIT 

PARSE     ;get old name, new name and national

 +1        SET YSERR=1

           SET YSDATA(1)="[ERROR]"

 +2        SET YSNAM=$GET(YS("CODE"))

 +3       ;-->out

           IF YSNAM=""

               SET YSDATA(2)="no code"

               QUIT 

 +4       ;--->out

           IF '$DATA(^YTT(601.71,"B",YSNAM))

               SET YSDATA(2)="bad code"

               QUIT 

 +5        SET YSNUM=$ORDER(^YTT(601.71,"B",YSNAM,0))

           SET YSDATA(1)="[DATA]"

           SET YSERR=0

 +6        QUIT 

MAIL      ;Mailman

 +1        NEW XMSUB,XMTEXT,XMDUZ,XMY

 +2        SET XMSUB="Export of "_YS("CODE")

 +3        SET XMTEXT="^TMP($J,""YSE"","

 +4        SET XMY(DUZ)=""

 +5        SET XMDUZ="AUTOMATED MESSAGE"

 +6        DO ^XMD

 +7        QUIT 

SET(YSIEN) ;content set

 +1        SET N=-1

           FOR 

               SET N=$ORDER(^YTT(YSFILE,YSIEN,N))

               if N=""

                   QUIT 

               DO G1

 +2        QUIT 

G1         if $DATA(^YTT(YSFILE,YSIEN,N))#2

               Begin DoDot:1

 +1                SET YSCNT=YSCNT+1

 +2                SET ^TMP($JOB,"YSE",YSCNT)="^TMP($J,""YSI"","_YSFILE_","_YSIEN_","_N_")"

 +3                SET YSCNT=YSCNT+1

 +4                SET ^TMP($JOB,"YSE",YSCNT)=^YTT(YSFILE,YSIEN,N)

               End DoDot:1

           SET N1=-1

           FOR 

               SET N1=$ORDER(^YTT(YSFILE,YSIEN,N,N1))

               if N1=""

                   QUIT 

               DO G2

 +5        QUIT 

G2         if $DATA(^YTT(YSFILE,YSIEN,N,N1))#2

               Begin DoDot:1

 +1                SET YSCNT=YSCNT+1

 +2                SET ^TMP($JOB,"YSE",YSCNT)="^TMP($J,""YSI"","_YSFILE_","_YSIEN_","_N_","_N1_")"

 +3                SET YSCNT=YSCNT+1

 +4                SET ^TMP($JOB,"YSE",YSCNT)=^YTT(YSFILE,YSIEN,N,N1)

               End DoDot:1

           SET N2=-1

           FOR 

               SET N2=$ORDER(^YTT(YSFILE,YSIEN,N,N1,N2))

               if N2=""

                   QUIT 

               DO G3

 +5        QUIT 

G3         if $DATA(^YTT(YSFILE,YSIEN,N,N1,N2))#2

               Begin DoDot:1

 +1                SET YSCNT=YSCNT+1

 +2                SET ^TMP($JOB,"YSE",YSCNT)="^TMP($J,""YSI"","_YSFILE_","_YSIEN_","_N_","_N1_","_N2_")"

 +3                SET YSCNT=YSCNT+1

 +4                SET ^TMP($JOB,"YSE",YSCNT)=^YTT(YSFILE,YSIEN,N,N1,N2)

               End DoDot:1

 +5        QUIT