ACDFLAT ;IHS/ADC/EDE/KML - GENERATE FLAT FILE;
;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
;
; This routine generates a flat ascii file for cdmis visits
; by a date range entered by the user.
;
START ;
D INIT
I ACDQ D EOJ Q
;D VISITLP
I ACDQ D EOJ Q
D PRVNTLP
I ACDQ D EOJ Q
D GENFILE
D EOJ
Q
;
INIT ; INITIALIZATION
K ^TMP("ACDFLAT",$J)
S ACDQ=1
I '$G(ACDPGM) W !!,"No Program Specified.",!! Q
I $G(ACD6DIG)="" S ACD6DIG=$P($G(^AUTTLOC(ACDPGM,0)),U,10) I $L(ACD6DIG)'=6 W !!,"Invalid ASUFAC code for Program.",!! Q
W !!,"This routine will generate a flat ascii file containing CDMIS visits within",!,"the date range you specify.",!
D GETDTR^ACDDEU
Q:ACDQ
S ACDRCTR=0
S ACDQ=0
D FILEMSG
Q
;
FILEMSG ; GENERATE FILE NAME AND TELL USER
S ACDFILE="ACD"_DUZ_"."
S X2=$E(DT,1,3)_"0101",X1=DT D ^%DTC S ACDJD=X+1
S ACDFILE=ACDFILE_ACDJD
W !!,"I am going to create a file called ",ACDFILE," 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,"********** ",ACDFILE," **********",!
W !,"As a reminder, the records that are generated and placed in file ",ACDFILE,!
W "are in a standard, pre-defined record format. For a definition of the format",!,"please see your user manual.",!
S DIR(0)="Y",DIR("A")="Is everything ok? Do you want to continue?",DIR("B")="Y" K DA D ^DIR K DIR
I $D(DIRUT)!(Y'=1) S ACDQ=1 Q
Q
;
VISITLP ; LOOP ON VISITS BY DATE UNTIL DONE
S ACDVDT=$O(^ACDVIS("B",ACDDTLO),-1)
F S ACDVDT=$O(^ACDVIS("B",ACDVDT)) Q:ACDVDT=""!(ACDVDT>ACDDTHI) S ACDVIEN=0 F S ACDVIEN=$O(^ACDVIS("B",ACDVDT,ACDVIEN)) Q:'ACDVIEN D:$P($G(^ACDVIS(ACDVIEN,"BWP")),U)=ACDPGM BLDRECV
Q
;
BLDRECV ; BUILD FLAT RECORD FROM ONE CDMIS VISIT
S C=$$FLAT^ACDFLAT2(ACDVIEN,.ACDFREC)
I C F Y=1:1:C D
. S ACDRCTR=ACDRCTR+1
. S ^TMP("ACDFLAT",$J,ACDRCTR)=ACDFREC(Y)
.;D:$E(ACDFREC(Y),18,19)="IN" EP^XBCLM(ACDFREC(Y)) ;*****DEBUG*****
. W:'(ACDRCTR#100) "."
. Q
Q
;
PRVNTLP ; LOOP ON PREVENTIONS BY DATE UNTIL DONE
S ACDPDT=$O(^ACDPD("B",ACDDTLO),-1)
F S ACDPDT=$O(^ACDPD("B",ACDPDT)) Q:ACDPDT=""!(ACDPDT>ACDDTHI) S ACDPIEN=0 F S ACDPIEN=$O(^ACDPD("B",ACDPDT,ACDPIEN)) Q:'ACDPIEN D:$P($G(^ACDPD(ACDPIEN,0)),U,4)=ACDPGM BLDRECP
Q
;
BLDRECP ; BUILD FLAT RECORD FROM ONE CDMIS PREVENTION
S C=$$FLAT^ACDFLAT4(ACDPIEN,.ACDFREC)
I C F Y=1:1:C D
. S ACDRCTR=ACDRCTR+1
. S ^TMP("ACDFLAT",$J,ACDRCTR)=ACDFREC(Y)
. D:$E(ACDFREC(Y),18,19)="IN" EP^XBCLM(ACDFREC(Y)) ;*****DEBUG*****
. W:'(ACDRCTR#100) "."
. Q
Q
;
GENFILE ; GENERATE FLAT ASCII FILE
K ^TMP($J,"ACDFLAT")
S %X="^TMP(""ACDFLAT"",$J,"
S %Y="^TMP($J,""ACDFLAT"","
D %XY^%RCR
K %X,%Y
;
S XBGL="TMP("_$J_",""ACDFLAT"","
S XBMED="F",XBFN=ACDFILE,XBTLE="SAVE OF CDMIS RECORDS FOR DATE RANGE "_ACDDTLO_"-"_ACDDTHI_" GENERATED BY -"_$P($G(^VA(200,DUZ,0)),U)
S XBF=0,XBQ="N",XBFLT=1,XBE=$J
D ^XBGSAVE
;check for error
K ^TMP($J,"ACDFLAT")
K XBGL,XBMED,XBTLE,XBFN,XBF,XBQ,XBFLT
D PAUSE^ACDDEU
Q
;
EOJ ;
K ^TMP("ACDFLAT",$J)
D ^ACDKILL
Q
ACDFLAT ;IHS/ADC/EDE/KML - GENERATE FLAT FILE;
+1 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
+2 ;
+3 ; This routine generates a flat ascii file for cdmis visits
+4 ; by a date range entered by the user.
+5 ;
START ;
+1 DO INIT
+2 IF ACDQ
DO EOJ
QUIT
+3 ;D VISITLP
+4 IF ACDQ
DO EOJ
QUIT
+5 DO PRVNTLP
+6 IF ACDQ
DO EOJ
QUIT
+7 DO GENFILE
+8 DO EOJ
+9 QUIT
+10 ;
INIT ; INITIALIZATION
+1 KILL ^TMP("ACDFLAT",$JOB)
+2 SET ACDQ=1
+3 IF '$GET(ACDPGM)
WRITE !!,"No Program Specified.",!!
QUIT
+4 IF $GET(ACD6DIG)=""
SET ACD6DIG=$PIECE($GET(^AUTTLOC(ACDPGM,0)),U,10)
IF $LENGTH(ACD6DIG)'=6
WRITE !!,"Invalid ASUFAC code for Program.",!!
QUIT
+5 WRITE !!,"This routine will generate a flat ascii file containing CDMIS visits within",!,"the date range you specify.",!
+6 DO GETDTR^ACDDEU
+7 IF ACDQ
QUIT
+8 SET ACDRCTR=0
+9 SET ACDQ=0
+10 DO FILEMSG
+11 QUIT
+12 ;
FILEMSG ; GENERATE FILE NAME AND TELL USER
+1 SET ACDFILE="ACD"_DUZ_"."
+2 SET X2=$EXTRACT(DT,1,3)_"0101"
SET X1=DT
DO ^%DTC
SET ACDJD=X+1
+3 SET ACDFILE=ACDFILE_ACDJD
+4 WRITE !!,"I am going to create a file called ",ACDFILE," 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,"********** ",ACDFILE," **********",!
+7 WRITE !,"As a reminder, the records that are generated and placed in file ",ACDFILE,!
+8 WRITE "are in a standard, pre-defined record format. For a definition of the format",!,"please see your user manual.",!
+9 SET DIR(0)="Y"
SET DIR("A")="Is everything ok? Do you want to continue?"
SET DIR("B")="Y"
KILL DA
DO ^DIR
KILL DIR
+10 IF $DATA(DIRUT)!(Y'=1)
SET ACDQ=1
QUIT
+11 QUIT
+12 ;
VISITLP ; LOOP ON VISITS BY DATE UNTIL DONE
+1 SET ACDVDT=$ORDER(^ACDVIS("B",ACDDTLO),-1)
+2 FOR
SET ACDVDT=$ORDER(^ACDVIS("B",ACDVDT))
IF ACDVDT=""!(ACDVDT>ACDDTHI)
QUIT
SET ACDVIEN=0
FOR
SET ACDVIEN=$ORDER(^ACDVIS("B",ACDVDT,ACDVIEN))
IF 'ACDVIEN
QUIT
IF $PIECE($GET(^ACDVIS(ACDVIEN,"BWP")),U)=ACDPGM
DO BLDRECV
+3 QUIT
+4 ;
BLDRECV ; BUILD FLAT RECORD FROM ONE CDMIS VISIT
+1 SET C=$$FLAT^ACDFLAT2(ACDVIEN,.ACDFREC)
+2 IF C
FOR Y=1:1:C
Begin DoDot:1
+3 SET ACDRCTR=ACDRCTR+1
+4 SET ^TMP("ACDFLAT",$JOB,ACDRCTR)=ACDFREC(Y)
+5 ;D:$E(ACDFREC(Y),18,19)="IN" EP^XBCLM(ACDFREC(Y)) ;*****DEBUG*****
+6 IF '(ACDRCTR#100)
WRITE "."
+7 QUIT
End DoDot:1
+8 QUIT
+9 ;
PRVNTLP ; LOOP ON PREVENTIONS BY DATE UNTIL DONE
+1 SET ACDPDT=$ORDER(^ACDPD("B",ACDDTLO),-1)
+2 FOR
SET ACDPDT=$ORDER(^ACDPD("B",ACDPDT))
IF ACDPDT=""!(ACDPDT>ACDDTHI)
QUIT
SET ACDPIEN=0
FOR
SET ACDPIEN=$ORDER(^ACDPD("B",ACDPDT,ACDPIEN))
IF 'ACDPIEN
QUIT
IF $PIECE($GET(^ACDPD(ACDPIEN,0)),U,4)=ACDPGM
DO BLDRECP
+3 QUIT
+4 ;
BLDRECP ; BUILD FLAT RECORD FROM ONE CDMIS PREVENTION
+1 SET C=$$FLAT^ACDFLAT4(ACDPIEN,.ACDFREC)
+2 IF C
FOR Y=1:1:C
Begin DoDot:1
+3 SET ACDRCTR=ACDRCTR+1
+4 SET ^TMP("ACDFLAT",$JOB,ACDRCTR)=ACDFREC(Y)
+5 ;*****DEBUG*****
IF $EXTRACT(ACDFREC(Y),18,19)="IN"
DO EP^XBCLM(ACDFREC(Y))
+6 IF '(ACDRCTR#100)
WRITE "."
+7 QUIT
End DoDot:1
+8 QUIT
+9 ;
GENFILE ; GENERATE FLAT ASCII FILE
+1 KILL ^TMP($JOB,"ACDFLAT")
+2 SET %X="^TMP(""ACDFLAT"",$J,"
+3 SET %Y="^TMP($J,""ACDFLAT"","
+4 DO %XY^%RCR
+5 KILL %X,%Y
+6 ;
+7 SET XBGL="TMP("_$JOB_",""ACDFLAT"","
+8 SET XBMED="F"
SET XBFN=ACDFILE
SET XBTLE="SAVE OF CDMIS RECORDS FOR DATE RANGE "_ACDDTLO_"-"_ACDDTHI_" GENERATED BY -"_$PIECE($GET(^VA(200,DUZ,0)),U)
+9 SET XBF=0
SET XBQ="N"
SET XBFLT=1
SET XBE=$JOB
+10 DO ^XBGSAVE
+11 ;check for error
+12 KILL ^TMP($JOB,"ACDFLAT")
+13 KILL XBGL,XBMED,XBTLE,XBFN,XBF,XBQ,XBFLT
+14 DO PAUSE^ACDDEU
+15 QUIT
+16 ;
EOJ ;
+1 KILL ^TMP("ACDFLAT",$JOB)
+2 DO ^ACDKILL
+3 QUIT
