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 ---[H[J[2J[HYTQAPI12 4406 printed Nov 22, 2024@17:28:09 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
