ACMRLF.m

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