YTQAPI12.m

YTQAPI12 ;ASF/ALB MHQ IMPORT PROCEEDURES ; 4/3/07 11:14am

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

 Q

IMPORT(YSATA,YS) ;

 K ^TMP($J)

 N YSERR,YSMS,%X,%Y,DA,DIK,N,X,Y,YSCP,YSEND,YSFILE,YSFL,YSFLD,YSGL,YSNEW,YSNVAL,YSOVAL,YSPF

 S YSMS=$G(YS("MESSAGE"))

 I YSMS="" S YSDATA(1)="[ERROR]",YSDATA(2)="no msg #" Q  ;-->out

 I YSMS'?1N.N S YSDATA(1)="[ERROR]",YSDATA(2)="bad msg #" Q  ;-->out

 S X=$$GET1^DIQ(3.9,YSMS_",",3,,"^TMP($J,""YSM"")","YSERR")

 I $D(YSERR) S YSDATA(1)="[ERROR]",YSDATA(2)="no load" Q  ;-->out

 S N=0,YSEND=0 F  D  Q:YSEND  S @X=Y

 . S N=N+1,X=$G(^TMP($J,"YSM",N))

 . S:X="" YSEND=1

 . S N=N+1,Y=$G(^TMP($J,"YSM",N))

 K ^TMP($J,"YSM")

 D RAWLOAD ;load into 601 files

 D POINT ;re point foreign keys

 Q

RAWLOAD ; load into new iens

 F YSFL=71,72,73,75,751,76,79,81,82,83,86,87,88,89,91 D

 . S YSFILE="601."_YSFL

 . S N=0  F  S N=$O(^TMP($J,"YSI",YSFILE,N)) Q:N'>0  D

 .. S YSNEW=$$NEW^YTQLIB(YSFILE)

 .. S ^TMP($J,"YSOLD",YSFILE,N)=YSNEW

 .. S %X="^TMP($J,""YSI"","_YSFILE_","_N_","

 .. S %Y="^YTT("_YSFILE_","_YSNEW_","

 .. D %XY^%RCR

 .. I (YSFILE'=601.71)&(YSFILE'=601.751) S $P(^YTT(YSFILE,YSNEW,0),U)=YSNEW

 .. S DA=YSNEW,DIK="^YTT("_YSFILE_"," D IX^DIK ;xref

 Q

POINT ; set relational keys

 S YSFILE=601.72,YSFLD=2,YSPF=601.73 D FK ;quest intro

 ;S YSFILE=601.751,YSFLD=2,YSPF=601.75 D FK ;

 S YSFILE=601.76,YSFLD=7,YSPF=601.88 D FK ;

 S YSFILE=601.76,YSFLD=8,YSPF=601.88 D FK ;

 S YSFILE=601.76,YSFLD=9,YSPF=601.88 D FK ;

 S YSFILE=601.76,YSFLD=3,YSPF=601.72 D FK ;

 S YSFILE=601.76,YSFLD=1,YSPF=601.71 D FK ;

 S YSFILE=601.79,YSFLD=3,YSPF=601.72 D FK ;

 S YSFILE=601.79,YSFLD=2,YSPF=601.82 D FK ;

 S YSFILE=601.79,YSFLD=1,YSPF=601.71 D FK ;

 S YSFILE=601.81,YSFLD=1,YSPF=601.71 D FK ;

 S YSFILE=601.81,YSFLD=2,YSPF=601.72 D FK ;

 S YSFILE=601.81,YSFLD=6,YSPF=601.88 D FK ;

 S YSFILE=601.82,YSFLD=1,YSPF=601.72 D FK ;

 S YSFILE=601.82,YSFLD=6,YSPF=601.72 D FK ;

 S YSFILE=601.83,YSFLD=2,YSPF=601.72 D FK ;

 S YSFILE=601.83,YSFLD=3,YSPF=601.82 D FK ;

 S YSFILE=601.83,YSFLD=1,YSPF=601.73 D FK ;

 S YSFILE=601.86,YSFLD=1,YSPF=601.71 D FK ;

 S YSFILE=601.87,YSFLD=1,YSPF=601.86 D FK ;

 S YSFILE=601.91,YSFLD=2,YSPF=601.72 D FK ;

 S YSFILE=601.91,YSFLD=1,YSPF=601.87 D FK ;

 Q

FK ;foreign keys

 S N=0 F  S N=$O(^TMP($J,"YSI",YSFILE,N)) Q:N'>0  D

 . S YSNEW=^TMP($J,"YSOLD",YSFILE,N)

 . S YSGL=$P(^DD(YSFILE,YSFLD,0),U,4),YSCP=$P(YSGL,";",2),YSGL=+YSGL

 . Q:YSCP=""

 . S YSOVAL=$P($G(^YTT(YSFILE,YSNEW,YSGL)),U,YSCP)

 . Q:YSOVAL'?1N.E

 . S YSNVAL=$G(^TMP($J,"YSOLD",YSPF,YSOVAL))

 . ;I YSNVAL'?1N.N W !,"YSFILE= ",YSFILE,"  YSGL= ",YSGL,"  YSCP= ",YSCP," TMPOLD= ",$G(^TMP($J,"YSOLD",YSPF,YSOVAL)) Q

 . S $P(^YTT(YSFILE,YSNEW,YSGL),U,YSCP)=YSNVAL

 . S DA=YSNEW,DIK="^YTT("_YSFILE_",",DIK(1)=YSFLD D EN^DIK

 Q

MLIST(YSDATA) ;LISTMSGS^XMXAPIB(XMDUZ,XMK,XMFLDS,XMFLAGS,XMAMT,.XMSTART,.XMCRIT,XMTROOT)

 ;returns list of exported tests in mailbox

 ;input: none

 ;output : msg #^subject^date

 N XMCRIT,N

 K ^TMP("XMLIST",$J)

 K ^TMP("YSMAIL",$J) S YSDATA=$NA(^TMP("YSMAIL",$J))

 S XMCRIT("SUBJ")="EXPORT OF"

 D LISTMSGS^XMXAPIB(DUZ,"*","SUBJ;DATE","B",,,.XMCRIT)

 I $D(^TMP("XMERR",$J)) S ^TMP("YSMAIL",$J,1)="[ERROR]",^TMP("YSMAIL",$J,2)="LISTMSG err" Q  ;-->out

 S ^TMP("YSMAIL",$J,1)="[DATA]"

 S N=0 F  S N=$O(^TMP("XMLIST",$J,N)) Q:N'>0  D

 . S ^TMP("YSMAIL",$J,N+1)=^TMP("XMLIST",$J,N)_U_$G(^TMP("XMLIST",$J,N,"SUBJ"))_U_$P($G(^TMP("XMLIST",$J,N,"DATE")),U,1)

 Q

LISTASI(YSDATA,YS) ;ASI LISTER

 ;REQUIRES: DFN

 ;RETURNS: IEN=DATE OF INTERVIEW^CLASS^SPECIAL^ESIGNED^INTERVIEWER(E)^INTERVIWER(I)

 ;0 RETURNED IF NO ADMINS

 N DFN,YSIEN,YSN

 K ^TMP("YSDATA",$J) S YSDATA=$NA(^TMP("YSDATA",$J))

 S DFN=$G(YS("DFN"))

 I DFN<1 S ^TMP("YSDATA",$J,1)="[ERROR]^bad DFN" Q  ;--->OUT

 S YSN=1

 S YSIEN=0

 S ^TMP("YSDATA",$J,1)="[DATA]^0"

 F  S YSIEN=$O(^YSTX(604,"C",DFN,YSIEN)) Q:YSIEN'>0  D  S ^TMP("YSDATA",$J,1)="[DATA]^"_(YSN-1)

 . S YSN=YSN+1

 . S ^TMP("YSDATA",$J,YSN)=YSIEN_"="_$$FMTE^XLFDT($$GET1^DIQ(604,YSIEN_",",.05,"I"),"5ZD")_U_$$GET1^DIQ(604,YSIEN_",",.04,"E")_U_$$GET1^DIQ(604,YSIEN_",",.11,"E")_U_$$GET1^DIQ(604,YSIEN_",",.51,"E")

 . S ^TMP("YSDATA",$J,YSN)=^TMP("YSDATA",$J,YSN)_U_$$GET1^DIQ(604,YSIEN_",",.09,"E")_U_$$GET1^DIQ(604,YSIEN_",",.09,"I")

 . S ^TMP("YSDATA",$J,YSN)=^TMP("YSDATA",$J,YSN)_U_$$GET1^DIQ(604,YSIEN_",",.09,"E")_U_$$GET1^DIQ(604,YSIEN_",",.09,"I")

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---YTQAPI12   4406     printed  Mar 13, 2025@21:22:59                                                                                                                                                                                                    Page 2

YTQAPI12  ;ASF/ALB MHQ IMPORT PROCEEDURES ; 4/3/07 11:14am

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

 +2        QUIT 

IMPORT(YSATA,YS) ;

 +1        KILL ^TMP($JOB)

 +2        NEW YSERR,YSMS,%X,%Y,DA,DIK,N,X,Y,YSCP,YSEND,YSFILE,YSFL,YSFLD,YSGL,YSNEW,YSNVAL,YSOVAL,YSPF

 +3        SET YSMS=$GET(YS("MESSAGE"))

 +4       ;-->out

           IF YSMS=""

               SET YSDATA(1)="[ERROR]"

               SET YSDATA(2)="no msg #"

               QUIT 

 +5       ;-->out

           IF YSMS'?1N.N

               SET YSDATA(1)="[ERROR]"

               SET YSDATA(2)="bad msg #"

               QUIT 

 +6        SET X=$$GET1^DIQ(3.9,YSMS_",",3,,"^TMP($J,""YSM"")","YSERR")

 +7       ;-->out

           IF $DATA(YSERR)

               SET YSDATA(1)="[ERROR]"

               SET YSDATA(2)="no load"

               QUIT 

 +8        SET N=0

           SET YSEND=0

           FOR 

               Begin DoDot:1

 +9                SET N=N+1

                   SET X=$GET(^TMP($JOB,"YSM",N))

 +10               if X=""

                       SET YSEND=1

 +11               SET N=N+1

                   SET Y=$GET(^TMP($JOB,"YSM",N))

               End DoDot:1

               if YSEND

                   QUIT 

               SET @X=Y

 +12       KILL ^TMP($JOB,"YSM")

 +13      ;load into 601 files

           DO RAWLOAD

 +14      ;re point foreign keys

           DO POINT

 +15       QUIT 

RAWLOAD   ; load into new iens

 +1        FOR YSFL=71,72,73,75,751,76,79,81,82,83,86,87,88,89,91

               Begin DoDot:1

 +2                SET YSFILE="601."_YSFL

 +3                SET N=0

                   FOR 

                       SET N=$ORDER(^TMP($JOB,"YSI",YSFILE,N))

                       if N'>0

                           QUIT 

                       Begin DoDot:2

 +4                        SET YSNEW=$$NEW^YTQLIB(YSFILE)

 +5                        SET ^TMP($JOB,"YSOLD",YSFILE,N)=YSNEW

 +6                        SET %X="^TMP($J,""YSI"","_YSFILE_","_N_","

 +7                        SET %Y="^YTT("_YSFILE_","_YSNEW_","

 +8                        DO %XY^%RCR

 +9                        IF (YSFILE'=601.71)&(YSFILE'=601.751)

                               SET $PIECE(^YTT(YSFILE,YSNEW,0),U)=YSNEW

 +10      ;xref

                           SET DA=YSNEW

                           SET DIK="^YTT("_YSFILE_","

                           DO IX^DIK

                       End DoDot:2

               End DoDot:1

 +11       QUIT 

POINT     ; set relational keys

 +1       ;quest intro

           SET YSFILE=601.72

           SET YSFLD=2

           SET YSPF=601.73

           DO FK

 +2       ;S YSFILE=601.751,YSFLD=2,YSPF=601.75 D FK ;

 +3       ;

           SET YSFILE=601.76

           SET YSFLD=7

           SET YSPF=601.88

           DO FK

 +4       ;

           SET YSFILE=601.76

           SET YSFLD=8

           SET YSPF=601.88

           DO FK

 +5       ;

           SET YSFILE=601.76

           SET YSFLD=9

           SET YSPF=601.88

           DO FK

 +6       ;

           SET YSFILE=601.76

           SET YSFLD=3

           SET YSPF=601.72

           DO FK

 +7       ;

           SET YSFILE=601.76

           SET YSFLD=1

           SET YSPF=601.71

           DO FK

 +8       ;

           SET YSFILE=601.79

           SET YSFLD=3

           SET YSPF=601.72

           DO FK

 +9       ;

           SET YSFILE=601.79

           SET YSFLD=2

           SET YSPF=601.82

           DO FK

 +10      ;

           SET YSFILE=601.79

           SET YSFLD=1

           SET YSPF=601.71

           DO FK

 +11      ;

           SET YSFILE=601.81

           SET YSFLD=1

           SET YSPF=601.71

           DO FK

 +12      ;

           SET YSFILE=601.81

           SET YSFLD=2

           SET YSPF=601.72

           DO FK

 +13      ;

           SET YSFILE=601.81

           SET YSFLD=6

           SET YSPF=601.88

           DO FK

 +14      ;

           SET YSFILE=601.82

           SET YSFLD=1

           SET YSPF=601.72

           DO FK

 +15      ;

           SET YSFILE=601.82

           SET YSFLD=6

           SET YSPF=601.72

           DO FK

 +16      ;

           SET YSFILE=601.83

           SET YSFLD=2

           SET YSPF=601.72

           DO FK

 +17      ;

           SET YSFILE=601.83

           SET YSFLD=3

           SET YSPF=601.82

           DO FK

 +18      ;

           SET YSFILE=601.83

           SET YSFLD=1

           SET YSPF=601.73

           DO FK

 +19      ;

           SET YSFILE=601.86

           SET YSFLD=1

           SET YSPF=601.71

           DO FK

 +20      ;

           SET YSFILE=601.87

           SET YSFLD=1

           SET YSPF=601.86

           DO FK

 +21      ;

           SET YSFILE=601.91

           SET YSFLD=2

           SET YSPF=601.72

           DO FK

 +22      ;

           SET YSFILE=601.91

           SET YSFLD=1

           SET YSPF=601.87

           DO FK

 +23       QUIT 

FK        ;foreign keys

 +1        SET N=0

           FOR 

               SET N=$ORDER(^TMP($JOB,"YSI",YSFILE,N))

               if N'>0

                   QUIT 

               Begin DoDot:1

 +2                SET YSNEW=^TMP($JOB,"YSOLD",YSFILE,N)

 +3                SET YSGL=$PIECE(^DD(YSFILE,YSFLD,0),U,4)

                   SET YSCP=$PIECE(YSGL,";",2)

                   SET YSGL=+YSGL

 +4                if YSCP=""

                       QUIT 

 +5                SET YSOVAL=$PIECE($GET(^YTT(YSFILE,YSNEW,YSGL)),U,YSCP)

 +6                if YSOVAL'?1N.E

                       QUIT 

 +7                SET YSNVAL=$GET(^TMP($JOB,"YSOLD",YSPF,YSOVAL))

 +8       ;I YSNVAL'?1N.N W !,"YSFILE= ",YSFILE,"  YSGL= ",YSGL,"  YSCP= ",YSCP," TMPOLD= ",$G(^TMP($J,"YSOLD",YSPF,YSOVAL)) Q

 +9                SET $PIECE(^YTT(YSFILE,YSNEW,YSGL),U,YSCP)=YSNVAL

 +10               SET DA=YSNEW

                   SET DIK="^YTT("_YSFILE_","

                   SET DIK(1)=YSFLD

                   DO EN^DIK

               End DoDot:1

 +11       QUIT 

MLIST(YSDATA) ;LISTMSGS^XMXAPIB(XMDUZ,XMK,XMFLDS,XMFLAGS,XMAMT,.XMSTART,.XMCRIT,XMTROOT)

 +1       ;returns list of exported tests in mailbox

 +2       ;input: none

 +3       ;output : msg #^subject^date

 +4        NEW XMCRIT,N

 +5        KILL ^TMP("XMLIST",$JOB)

 +6        KILL ^TMP("YSMAIL",$JOB)

           SET YSDATA=$NAME(^TMP("YSMAIL",$JOB))

 +7        SET XMCRIT("SUBJ")="EXPORT OF"

 +8        DO LISTMSGS^XMXAPIB(DUZ,"*","SUBJ;DATE","B",,,.XMCRIT)

 +9       ;-->out

           IF $DATA(^TMP("XMERR",$JOB))

               SET ^TMP("YSMAIL",$JOB,1)="[ERROR]"

               SET ^TMP("YSMAIL",$JOB,2)="LISTMSG err"

               QUIT 

 +10       SET ^TMP("YSMAIL",$JOB,1)="[DATA]"

 +11       SET N=0

           FOR 

               SET N=$ORDER(^TMP("XMLIST",$JOB,N))

               if N'>0

                   QUIT 

               Begin DoDot:1

 +12               SET ^TMP("YSMAIL",$JOB,N+1)=^TMP("XMLIST",$JOB,N)_U_$GET(^TMP("XMLIST",$JOB,N,"SUBJ"))_U_$PIECE($GET(^TMP("XMLIST",$JOB,N,"DATE")),U,1)

               End DoDot:1

 +13       QUIT 

LISTASI(YSDATA,YS) ;ASI LISTER

 +1       ;REQUIRES: DFN

 +2       ;RETURNS: IEN=DATE OF INTERVIEW^CLASS^SPECIAL^ESIGNED^INTERVIEWER(E)^INTERVIWER(I)

 +3       ;0 RETURNED IF NO ADMINS

 +4        NEW DFN,YSIEN,YSN

 +5        KILL ^TMP("YSDATA",$JOB)

           SET YSDATA=$NAME(^TMP("YSDATA",$JOB))

 +6        SET DFN=$GET(YS("DFN"))

 +7       ;--->OUT

           IF DFN<1

               SET ^TMP("YSDATA",$JOB,1)="[ERROR]^bad DFN"

               QUIT 

 +8        SET YSN=1

 +9        SET YSIEN=0

 +10       SET ^TMP("YSDATA",$JOB,1)="[DATA]^0"

 +11       FOR 

               SET YSIEN=$ORDER(^YSTX(604,"C",DFN,YSIEN))

               if YSIEN'>0

                   QUIT 

               Begin DoDot:1

 +12               SET YSN=YSN+1

 +13               SET ^TMP("YSDATA",$JOB,YSN)=YSIEN_"="_$$FMTE^XLFDT($$GET1^DIQ(604,YSIEN_",",.05,"I"),"5ZD")_U_$$GET1^DIQ(604,YSIEN_",",.04,"E")_U_$$GET1^DIQ(604,YSIEN_",",.11,"E")_U_$$GET1^DIQ(604,YSIEN_",",.51,"E")

 +14               SET ^TMP("YSDATA",$JOB,YSN)=^TMP("YSDATA",$JOB,YSN)_U_$$GET1^DIQ(604,YSIEN_",",.09,"E")_U_$$GET1^DIQ(604,YSIEN_",",.09,"I")

 +15               SET ^TMP("YSDATA",$JOB,YSN)=^TMP("YSDATA",$JOB,YSN)_U_$$GET1^DIQ(604,YSIEN_",",.09,"E")_U_$$GET1^DIQ(604,YSIEN_",",.09,"I")

               End DoDot:1

               SET ^TMP("YSDATA",$JOB,1)="[DATA]^"_(YSN-1)

 +16       QUIT