ACMRLF ;IHS/CMI/LAB - flat file [ 10/17/05 11:48 AM ]
;;2.0;ACM CASE MANAGEMENT SYSTEM;**1,6**;JAN 10, 1996
;IHS/CMI/LAB - patch 1 flat file new routine
;IHS/CMI/TMJ - Patch #6 Entry Point Mark
;
FLATP ;EP
K ^TMP($J,"ACMFLAT")
I '$D(^XTMP("ACMRL",ACMJOB,ACMBTH)) Q
S (ACMSRTV,ACMFRST)="",ACMCNT=0 K ACMQUIT
F S ACMSRTV=$O(^XTMP("ACMRL",ACMJOB,ACMBTH,"DATA HITS",ACMSRTV)) Q:ACMSRTV=""!($D(ACMQUIT)) D V
D WRITEF
Q
V ;GETS DATA HITS
;get readable sort value
S ACMSRTR="",DFN=$O(^XTMP("ACMRL",ACMJOB,ACMBTH,"DATA HITS",ACMSRTV,0)) I DFN]"" S ACMCRIT=ACMSORT D
.S ACMIFN=$G(^ACM(41,"AC",DFN,ACMRG)) X:$D(^ACM(58.1,ACMSORT,3)) ^(3) S ACMSRTR=ACMPRNT
K ACMFRST
S DFN=0 F S DFN=$O(^XTMP("ACMRL",ACMJOB,ACMBTH,"DATA HITS",ACMSRTV,DFN)) Q:DFN'=+DFN!($D(ACMQUIT)) D
.S ACMIFN=$G(^ACM(41,"AC",DFN,ACMRG)) D PRINT
.Q
Q
PRINT ;
S ACMCNT=ACMCNT+1
S ACMI=0 F S ACMI=$O(^ACM(58.8,ACMRPT,12,ACMI)) Q:ACMI'=+ACMI!($D(ACMQUIT)) S ACMCRIT=$P(^ACM(58.8,ACMRPT,12,ACMI,0),U) D
.I '$P(^ACM(58.1,ACMCRIT,0),U,8) D SINGLE Q
.D MULT
.Q
Q
SINGLE ;process single valued item
K ACMPRNT
S ACMX=0
X:$D(^ACM(58.1,ACMCRIT,3)) ^(3)
S ^TMP($J,"ACMFLAT",ACMCNT)=$G(^TMP($J,"ACMFLAT",ACMCNT))_ACMPRNT_U
Q
MULT ;
K ACMPRNT,ACMPRNM S (ACMX,ACMPCNT)=0
X:$D(^ACM(58.1,ACMCRIT,3)) ^(3)
I '$D(ACMPRNM) S ACMPRNT="--" D
.S ACMLENG=$P(^ACM(58.8,ACMRPT,12,ACMI,0),U,2),ACMPRNT=$E(ACMPRNT,1,ACMLENG) D
..S J=$L(ACMPRNT),^XTMP("ACMLINE",$J,1)=^XTMP("ACMLINE",$J,1)_ACMPRNT,K=$P(^ACM(58.8,ACMRPT,12,ACMI,0),U,2)+1 F I=J:1:K S ^XTMP("ACMLINE",$J,1)=^XTMP("ACMLINE",$J,1)_" "
S X=0 F S X=$O(ACMPRNM(X)) Q:X'=+X D
.I X=1 D Q
..S ACMLENG=$P(^ACM(58.8,ACMRPT,12,ACMI,0),U,2),ACMPRNT=$E(ACMPRNM(1),1,ACMLENG) D
...S J=$L(ACMPRNT),^XTMP("ACMLINE",$J,1)=^XTMP("ACMLINE",$J,1)_ACMPRNT,K=$P(^ACM(58.8,ACMRPT,12,ACMI,0),U,2)+1 F I=J:1:K S ^XTMP("ACMLINE",$J,1)=^XTMP("ACMLINE",$J,1)_" "
.S ACMLENG=$P(^ACM(58.8,ACMRPT,12,ACMI,0),U,2),ACMPRNT=$E(ACMPRNM(X),1,ACMLENG) D
..I '$D(^XTMP("ACMLINE",$J,X)) S ^XTMP("ACMLINE",$J,X)="",K=$P(^ACM(58.8,ACMRPT,12,ACMI,0),U,2)+1,$P(^XTMP("ACMLINE",$J,X)," ",($L(^XTMP("ACMLINE",$J,1))-K))=""
..S J=$L(ACMPRNT),^XTMP("ACMLINE",$J,X)=^XTMP("ACMLINE",$J,X)_ACMPRNT,K=$P(^ACM(58.8,ACMRPT,12,ACMI,0),U,2)+1 F I=J:1:K S ^XTMP("ACMLINE",$J,X)=^XTMP("ACMLINE",$J,X)_" "
S X=1 F S X=$O(^XTMP("ACMLINE",$J,X)) Q:X'=+X I $L(^XTMP("ACMLINE",$J,X))<$L(^XTMP("ACMLINE",$J,1)) S K=$L(^XTMP("ACMLINE",$J,X))+1,J=$L(^XTMP("ACMLINE",$J,1)) F I=K:1:J S ^XTMP("ACMLINE",$J,X)=^XTMP("ACMLINE",$J,X)_" "
Q
FLAT ;EP;Entry point from ACMRL3 IHS/CMI/TMJ PATCH #6
S ACMFFN="ACM"_DUZ_"."
S X=$G(^ACM(58.8,"FLATFILE")) S X=X+1,^ACM(58.8,"FLATFILE")=X
S ACMFFN=ACMFFN_X
W !!,"I am going to create a file called ",ACMFFN," which will reside in ",!,"the ",$S($P(^AUTTSITE(1,0),U,21)=1:"/usr/spool/uucppublic",1:"C:\EXPORT")," directory.",!
W "Actually, the file will be placed in the same directory that the data export"
W !,"globals are placed. See your site manager for assistance in finding the file",!,"after it is created. PLEASE jot down and remember the following file name:",!?15,"********** ",ACMFFN," **********",!
W !,"The records that are generated will be '^' delimited. The fields",!,"will be the fields you select in the next screen and will be in the order",!,"that you select them.",!
S DIR(0)="Y",DIR("A")="Do you want to continue?",DIR("B")="Y" K DA D ^DIR K DIR
I $D(DIRUT)!(Y'=1) S ACMQUIT=1 Q
S DA=ACMRPT,DR=".12///"_ACMFFN,DIE="^ACM(58.8," D ^DIE
K DIE,DA,DR
Q
WRITEF ;EP - write out flat file
I '$D(ZTQUEUED) W !!,"CMS File being generated...." H 2
S XBGL="TMP("_$J_",""ACMFLAT"","
S XBMED="F",XBFN=ACMFFN,XBTLE="SAVE OF CMS RECORDS GENERATED BY -"_$P(^VA(200,DUZ,0),U)
S XBF=0,XBQ="N",XBFLT=1,XBE=$J
D ^XBGSAVE
;check for error
K ^TMP($J,"ACMFLAT")
K XBGL,XBMED,XBTLE,XBFN,XBF,XBQ,XBFLT
Q
ACMRLF ;IHS/CMI/LAB - flat file [ 10/17/05 11:48 AM ]
+1 ;;2.0;ACM CASE MANAGEMENT SYSTEM;**1,6**;JAN 10, 1996
+2 ;IHS/CMI/LAB - patch 1 flat file new routine
+3 ;IHS/CMI/TMJ - Patch #6 Entry Point Mark
+4 ;
FLATP ;EP
+1 KILL ^TMP($JOB,"ACMFLAT")
+2 IF '$DATA(^XTMP("ACMRL",ACMJOB,ACMBTH))
QUIT
+3 SET (ACMSRTV,ACMFRST)=""
SET ACMCNT=0
KILL ACMQUIT
+4 FOR
SET ACMSRTV=$ORDER(^XTMP("ACMRL",ACMJOB,ACMBTH,"DATA HITS",ACMSRTV))
IF ACMSRTV=""!($DATA(ACMQUIT))
QUIT
DO V
+5 DO WRITEF
+6 QUIT
V ;GETS DATA HITS
+1 ;get readable sort value
+2 SET ACMSRTR=""
SET DFN=$ORDER(^XTMP("ACMRL",ACMJOB,ACMBTH,"DATA HITS",ACMSRTV,0))
IF DFN]""
SET ACMCRIT=ACMSORT
Begin DoDot:1
+3 SET ACMIFN=$GET(^ACM(41,"AC",DFN,ACMRG))
IF $DATA(^ACM(58.1,ACMSORT,3))
XECUTE ^(3)
SET ACMSRTR=ACMPRNT
End DoDot:1
+4 KILL ACMFRST
+5 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("ACMRL",ACMJOB,ACMBTH,"DATA HITS",ACMSRTV,DFN))
IF DFN'=+DFN!($DATA(ACMQUIT))
QUIT
Begin DoDot:1
+6 SET ACMIFN=$GET(^ACM(41,"AC",DFN,ACMRG))
DO PRINT
+7 QUIT
End DoDot:1
+8 QUIT
PRINT ;
+1 SET ACMCNT=ACMCNT+1
+2 SET ACMI=0
FOR
SET ACMI=$ORDER(^ACM(58.8,ACMRPT,12,ACMI))
IF ACMI'=+ACMI!($DATA(ACMQUIT))
QUIT
SET ACMCRIT=$PIECE(^ACM(58.8,ACMRPT,12,ACMI,0),U)
Begin DoDot:1
+3 IF '$PIECE(^ACM(58.1,ACMCRIT,0),U,8)
DO SINGLE
QUIT
+4 DO MULT
+5 QUIT
End DoDot:1
+6 QUIT
SINGLE ;process single valued item
+1 KILL ACMPRNT
+2 SET ACMX=0
+3 IF $DATA(^ACM(58.1,ACMCRIT,3))
XECUTE ^(3)
+4 SET ^TMP($JOB,"ACMFLAT",ACMCNT)=$GET(^TMP($JOB,"ACMFLAT",ACMCNT))_ACMPRNT_U
+5 QUIT
MULT ;
+1 KILL ACMPRNT,ACMPRNM
SET (ACMX,ACMPCNT)=0
+2 IF $DATA(^ACM(58.1,ACMCRIT,3))
XECUTE ^(3)
+3 IF '$DATA(ACMPRNM)
SET ACMPRNT="--"
Begin DoDot:1
+4 SET ACMLENG=$PIECE(^ACM(58.8,ACMRPT,12,ACMI,0),U,2)
SET ACMPRNT=$EXTRACT(ACMPRNT,1,ACMLENG)
Begin DoDot:2
+5 SET J=$LENGTH(ACMPRNT)
SET ^XTMP("ACMLINE",$JOB,1)=^XTMP("ACMLINE",$JOB,1)_ACMPRNT
SET K=$PIECE(^ACM(58.8,ACMRPT,12,ACMI,0),U,2)+1
FOR I=J:1:K
SET ^XTMP("ACMLINE",$JOB,1)=^XTMP("ACMLINE",$JOB,1)_" "
End DoDot:2
End DoDot:1
+6 SET X=0
FOR
SET X=$ORDER(ACMPRNM(X))
IF X'=+X
QUIT
Begin DoDot:1
+7 IF X=1
Begin DoDot:2
+8 SET ACMLENG=$PIECE(^ACM(58.8,ACMRPT,12,ACMI,0),U,2)
SET ACMPRNT=$EXTRACT(ACMPRNM(1),1,ACMLENG)
Begin DoDot:3
+9 SET J=$LENGTH(ACMPRNT)
SET ^XTMP("ACMLINE",$JOB,1)=^XTMP("ACMLINE",$JOB,1)_ACMPRNT
SET K=$PIECE(^ACM(58.8,ACMRPT,12,ACMI,0),U,2)+1
FOR I=J:1:K
SET ^XTMP("ACMLINE",$JOB,1)=^XTMP("ACMLINE",$JOB,1)_" "
End DoDot:3
End DoDot:2
QUIT
+10 SET ACMLENG=$PIECE(^ACM(58.8,ACMRPT,12,ACMI,0),U,2)
SET ACMPRNT=$EXTRACT(ACMPRNM(X),1,ACMLENG)
Begin DoDot:2
+11 IF '$DATA(^XTMP("ACMLINE",$JOB,X))
SET ^XTMP("ACMLINE",$JOB,X)=""
SET K=$PIECE(^ACM(58.8,ACMRPT,12,ACMI,0),U,2)+1
SET $PIECE(^XTMP("ACMLINE",$JOB,X)," ",($LENGTH(^XTMP("ACMLINE",$JOB,1))-K))=""
+12 SET J=$LENGTH(ACMPRNT)
SET ^XTMP("ACMLINE",$JOB,X)=^XTMP("ACMLINE",$JOB,X)_ACMPRNT
SET K=$PIECE(^ACM(58.8,ACMRPT,12,ACMI,0),U,2)+1
FOR I=J:1:K
SET ^XTMP("ACMLINE",$JOB,X)=^XTMP("ACMLINE",$JOB,X)_" "
End DoDot:2
End DoDot:1
+13 SET X=1
FOR
SET X=$ORDER(^XTMP("ACMLINE",$JOB,X))
IF X'=+X
QUIT
IF $LENGTH(^XTMP("ACMLINE",$JOB,X))<$LENGTH(^XTMP("ACMLINE",$JOB,1))
SET K=$LENGTH(^XTMP("ACMLINE",$JOB,X))+1
SET J=$LENGTH(^XTMP("ACMLINE",$JOB,1))
FOR I=K:1:J
SET ^XTMP("ACMLINE",$JOB,X)=^XTMP("ACMLINE",$JOB,X)_" "
+14 QUIT
FLAT ;EP;Entry point from ACMRL3 IHS/CMI/TMJ PATCH #6
+1 SET ACMFFN="ACM"_DUZ_"."
+2 SET X=$GET(^ACM(58.8,"FLATFILE"))
SET X=X+1
SET ^ACM(58.8,"FLATFILE")=X
+3 SET ACMFFN=ACMFFN_X
+4 WRITE !!,"I am going to create a file called ",ACMFFN," which will reside in ",!,"the ",$SELECT($PIECE(^AUTTSITE(1,0),U,21)=1:"/usr/spool/uucppublic",1:"C:\EXPORT")," directory.",!
+5 WRITE "Actually, the file will be placed in the same directory that the data export"
+6 WRITE !,"globals are placed. See your site manager for assistance in finding the file",!,"after it is created. PLEASE jot down and remember the following file name:",!?15,"********** ",ACMFFN," **********",!
+7 WRITE !,"The records that are generated will be '^' delimited. The fields",!,"will be the fields you select in the next screen and will be in the order",!,"that you select them.",!
+8 SET DIR(0)="Y"
SET DIR("A")="Do you want to continue?"
SET DIR("B")="Y"
KILL DA
DO ^DIR
KILL DIR
+9 IF $DATA(DIRUT)!(Y'=1)
SET ACMQUIT=1
QUIT
+10 SET DA=ACMRPT
SET DR=".12///"_ACMFFN
SET DIE="^ACM(58.8,"
DO ^DIE
+11 KILL DIE,DA,DR
+12 QUIT
WRITEF ;EP - write out flat file
+1 IF '$DATA(ZTQUEUED)
WRITE !!,"CMS File being generated...."
HANG 2
+2 SET XBGL="TMP("_$JOB_",""ACMFLAT"","
+3 SET XBMED="F"
SET XBFN=ACMFFN
SET XBTLE="SAVE OF CMS RECORDS GENERATED BY -"_$PIECE(^VA(200,DUZ,0),U)
+4 SET XBF=0
SET XBQ="N"
SET XBFLT=1
SET XBE=$JOB
+5 DO ^XBGSAVE
+6 ;check for error
+7 KILL ^TMP($JOB,"ACMFLAT")
+8 KILL XBGL,XBMED,XBTLE,XBFN,XBF,XBQ,XBFLT
+9 QUIT
