BGP2AU1R ; IHS/CMI/LAB - READ, PROCESS GPRA FILE ;
;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66
;
DESC ;
;;This routine reads the contents of the GPRA BGPGPCRSGPRA* files
;;and puts the data into FileMan file BGP GPRA FLAT FILE DATA.
;;
;;$$END
;
N I,X F I=1:1 S X=$P($T(DESC+I),";;",2) Q:X["$$END" D EN^DDIOL(X)
Q
EN(BGPF) ;EP -- MAIN ENTRY POINT
;
; INPUT:
; BGPF = ARRAY OF FILES TO BE UPLOADED
;
;
S BGP=0
F S BGP=$O(BGPF(BGP)) Q:'BGP D
. S BGPFILE=BGPF(BGP)
. Q:BGPFILE']""
. D ONE(BGPFILE)
Q
ONE(BGPFILE) ;
;----- PROCESS ONE FILE
;
N BGPOUT,BGPPATH
;
S BGPOUT=0
;
K ^TMP("BGPGP1RD",$J)
;
S BGPPATH=$P($G(^BGPGP1PM(1,1)),U)
;
D READ(BGPPATH,BGPFILE,.BGPOUT)
Q:BGPOUT
;
D PROC
K ^TMP("BGPGP1RD",$J)
;
Q
PROC ;
;----- PROCESS DATA
;
N BGP,BGP0,BGPBDT,BGPD0,BGPDATA,BGPEDT,BGPFAC,BGPID,BGPIND,BGPN,CNT,I,X,Y
;
S BGPDATA=$G(^TMP("BGPGP1RD",$J,"FILE",1,0))
F I=11:9:$L(BGPDATA,U) S X=$P(BGPDATA,U,I) S BGPIND(X)=I_U_(I+8)
;
S BGP=3
F S BGP=$O(^TMP("BGPGP1RD",$J,"FILE",BGP)) Q:'BGP D
. S BGP0=$G(^TMP("BGPGP1RD",$J,"FILE",BGP,0))
. S BGPFAC=$P(BGP0,U)
. S X=$P(BGP0,U,5)
. D ^%DT
. S BGPBDT=Y
. S X=$P(BGP0,U,6)
. D ^%DT
. S BGPEDT=Y
. S BGPN=""
. F S BGPN=$O(BGPIND(BGPN)) Q:BGPN']"" D
. . K BGPID,CNT
. . F S CNT=$G(CNT)+1 Q:$E(BGPN,CNT)'?1N S BGPID=$G(BGPID)_$E(BGPN,CNT)
. . S BGPIND=$P(BGPN,BGPID,2)
. . S BGPD0=$O(^BGPGP1RD("C",BGPIND,BGPFAC,BGPBDT,BGPEDT,0))
. . I 'BGPD0 D ADD(BGPIND,.BGPD0)
. . Q:BGPD0'>0
. . D EDIT(BGPD0,BGP0,BGPN,BGPID,.BGPIND)
Q
EDIT(BGPD0,BGP0,BGPN,BGPID,BGPIND) ;
;------ SET DATA INTO FILE
;
N BGPDATA,DA,DIE,DR,FR,TO
;
S DIE="^BGPGP1RD("
S DA=BGPD0
S FR=$P(BGPIND(BGPN),U)
S TO=$P(BGPIND(BGPN),U,2)
S BGPDATA=$P(BGP0,U,FR,TO)
S DR=".02///"_BGPID ;INDICATOR NUMBER
S DR=DR_";.03///"_$P(BGP0,U) ;SITE NAME
S DR=DR_";.04///"_$P(BGP0,U,2) ;ASUFAC
S DR=DR_";.05///"_$P(BGP0,U,3) ;DB ID
S DR=DR_";.06///"_$P(BGP0,U,4) ;DATE REPORT RUN
S DR=DR_";.07///"_$P(BGP0,U,5) ;CURRENT REPORT BEGIN DATE
S DR=DR_";.08///"_$P(BGP0,U,6) ;CURRENT REPORT END DATE
S DR=DR_";.09///"_$P(BGP0,U,7) ;PREVIOUS YEAR BEGIN DATE
S DR=DR_";.1///"_$P(BGP0,U,8) ;PREVIOUS YEAR END DATE
S DR=DR_";.11///"_$P(BGP0,U,9) ;BASELINE YEAR BEGIN DATE
S DR=DR_";.12///"_$P(BGP0,U,10) ;BASELINE YEAR END DATE
S DR=DR_";.13///"_$P(BGPDATA,U) ;CURRENT NUMERATOR
S DR=DR_";.14///"_$P(BGPDATA,U,2) ;CURRENT DENOMINATOR
S DR=DR_";.15///"_$P(BGPDATA,U,3) ;CURRENT PERCENT
S DR=DR_";.16///"_$P(BGPDATA,U,4) ;PREVIOUS NUMERATOR
S DR=DR_";.17///"_$P(BGPDATA,U,5) ;PREVIOUS DENOMINATOR
S DR=DR_";.18///"_$P(BGPDATA,U,6) ;PREVIOUS PERCENT
S DR=DR_";.19///"_$P(BGPDATA,U,7) ;BASELINE NUMERATOR
S DR=DR_";.2///"_$P(BGPDATA,U,8) ;BASELINE DENOMINATOR
S DR=DR_";.21///"_$P(BGPDATA,U,9) ;BASELINE PERCENT
D ^DIE
Q
ADD(BZIND,BGPD0) ;EP
;----- ADD NEW ENTRY
;
N DA,DD,DIC,DIE,DLAYGO,DO,DR,X,Y
;
S X=BGPIND
S DIC="^BGPGP1RD("
S DIC(0)=""
S DLAYGO=90245.1
D FILE^DICN
S BGPD0=+Y
;
Q
READ(BGPPATH,BGPFILE,BGPOUT) ;
;----- READ CONTENTS OF DATA FILE AND PUT INTO ^BGPTMP GLOBAL
;
N BGPCNT,BGPEND,I,POP,X
;
K ^TMP("BGPGP1RD",$J,BGPFILE)
S BGPOUT=0
S BGPEND=0
S BGPCNT=0
;W !,"READING FILE "_BGPPATH_BGPFILE_" ..."
D OPEN^%ZISH("FILE",BGPPATH,BGPFILE,"R")
I POP D
. W !?5,"UNABLE TO OPEN FILE '"_BGPPATH_BGPFILE_"'"
. S BGPOUT=1
Q:BGPOUT
F I=1:1 D Q:BGPEND
. U IO R X:DTIME
. I $$STATUS^%ZISH S BGPEND=1
. Q:BGPEND
. S BGPCNT=BGPCNT+1
. S ^TMP("BGPGP1RD",$J,"FILE",I,0)=X
. S ^TMP("BGPGP1RD",$J,"FILE",0)=BGPCNT
. I '(BGPCNT#100) U 0 W "."
;
D CLOSE^%ZISH("FILE")
Q
PATH(BGPPATH,BGPOUT) ;
;----- PROMPT FOR DIRECTORY PATH WHERE DATA FILE RESIDES
;
N DIR,DIRUT,DTOUT,DUOUT,X,Y
;
S BGPPATH=""
S BGPOUT=0
S DIR(0)="FA"
S DIR("A")="Select DIRECTORY: "
S DIR("?")="Enter the PATH or DIRECTORY where the data file resides, e.g., D:\EXPORT\"
D ^DIR
I $D(DTOUT)!($D(DIRUT))!($D(DUOUT)) S BGPOUT=1
Q:BGPOUT
S X=Y
D DF^%ZISH(.X)
S BGPPATH=X
Q
FILE(BGPFILE,BGPOUT) ;
;----- PROMPT FOR DATA FILE
;
N DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
;
S BGPFILE=""
S DIR(0)="FA"
S DIR("A")="Select FILE: "
S DIR("?")="Enter the name of the data file"
D ^DIR
I $D(DTOUT)!($D(DIRUT))!($D(DUOUT))!($D(DIROUT))!(Y[U) S BGPOUT=1
Q:$G(BGPOUT)
S BGPFILE=Y
Q
BGP2AU1R ; IHS/CMI/LAB - READ, PROCESS GPRA FILE ;
+1 ;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66
+2 ;
DESC ;
+1 ;;This routine reads the contents of the GPRA BGPGPCRSGPRA* files
+2 ;;and puts the data into FileMan file BGP GPRA FLAT FILE DATA.
+3 ;;
+4 ;;$$END
+5 ;
+6 NEW I,X
FOR I=1:1
SET X=$PIECE($TEXT(DESC+I),";;",2)
IF X["$$END"
QUIT
DO EN^DDIOL(X)
+7 QUIT
EN(BGPF) ;EP -- MAIN ENTRY POINT
+1 ;
+2 ; INPUT:
+3 ; BGPF = ARRAY OF FILES TO BE UPLOADED
+4 ;
+5 ;
+6 SET BGP=0
+7 FOR
SET BGP=$ORDER(BGPF(BGP))
IF 'BGP
QUIT
Begin DoDot:1
+8 SET BGPFILE=BGPF(BGP)
+9 IF BGPFILE']""
QUIT
+10 DO ONE(BGPFILE)
End DoDot:1
+11 QUIT
ONE(BGPFILE) ;
+1 ;----- PROCESS ONE FILE
+2 ;
+3 NEW BGPOUT,BGPPATH
+4 ;
+5 SET BGPOUT=0
+6 ;
+7 KILL ^TMP("BGPGP1RD",$JOB)
+8 ;
+9 SET BGPPATH=$PIECE($GET(^BGPGP1PM(1,1)),U)
+10 ;
+11 DO READ(BGPPATH,BGPFILE,.BGPOUT)
+12 IF BGPOUT
QUIT
+13 ;
+14 DO PROC
+15 KILL ^TMP("BGPGP1RD",$JOB)
+16 ;
+17 QUIT
PROC ;
+1 ;----- PROCESS DATA
+2 ;
+3 NEW BGP,BGP0,BGPBDT,BGPD0,BGPDATA,BGPEDT,BGPFAC,BGPID,BGPIND,BGPN,CNT,I,X,Y
+4 ;
+5 SET BGPDATA=$GET(^TMP("BGPGP1RD",$JOB,"FILE",1,0))
+6 FOR I=11:9:$LENGTH(BGPDATA,U)
SET X=$PIECE(BGPDATA,U,I)
SET BGPIND(X)=I_U_(I+8)
+7 ;
+8 SET BGP=3
+9 FOR
SET BGP=$ORDER(^TMP("BGPGP1RD",$JOB,"FILE",BGP))
IF 'BGP
QUIT
Begin DoDot:1
+10 SET BGP0=$GET(^TMP("BGPGP1RD",$JOB,"FILE",BGP,0))
+11 SET BGPFAC=$PIECE(BGP0,U)
+12 SET X=$PIECE(BGP0,U,5)
+13 DO ^%DT
+14 SET BGPBDT=Y
+15 SET X=$PIECE(BGP0,U,6)
+16 DO ^%DT
+17 SET BGPEDT=Y
+18 SET BGPN=""
+19 FOR
SET BGPN=$ORDER(BGPIND(BGPN))
IF BGPN']""
QUIT
Begin DoDot:2
+20 KILL BGPID,CNT
+21 FOR
SET CNT=$GET(CNT)+1
IF $EXTRACT(BGPN,CNT)'?1N
QUIT
SET BGPID=$GET(BGPID)_$EXTRACT(BGPN,CNT)
+22 SET BGPIND=$PIECE(BGPN,BGPID,2)
+23 SET BGPD0=$ORDER(^BGPGP1RD("C",BGPIND,BGPFAC,BGPBDT,BGPEDT,0))
+24 IF 'BGPD0
DO ADD(BGPIND,.BGPD0)
+25 IF BGPD0'>0
QUIT
+26 DO EDIT(BGPD0,BGP0,BGPN,BGPID,.BGPIND)
End DoDot:2
End DoDot:1
+27 QUIT
EDIT(BGPD0,BGP0,BGPN,BGPID,BGPIND) ;
+1 ;------ SET DATA INTO FILE
+2 ;
+3 NEW BGPDATA,DA,DIE,DR,FR,TO
+4 ;
+5 SET DIE="^BGPGP1RD("
+6 SET DA=BGPD0
+7 SET FR=$PIECE(BGPIND(BGPN),U)
+8 SET TO=$PIECE(BGPIND(BGPN),U,2)
+9 SET BGPDATA=$PIECE(BGP0,U,FR,TO)
+10 ;INDICATOR NUMBER
SET DR=".02///"_BGPID
+11 ;SITE NAME
SET DR=DR_";.03///"_$PIECE(BGP0,U)
+12 ;ASUFAC
SET DR=DR_";.04///"_$PIECE(BGP0,U,2)
+13 ;DB ID
SET DR=DR_";.05///"_$PIECE(BGP0,U,3)
+14 ;DATE REPORT RUN
SET DR=DR_";.06///"_$PIECE(BGP0,U,4)
+15 ;CURRENT REPORT BEGIN DATE
SET DR=DR_";.07///"_$PIECE(BGP0,U,5)
+16 ;CURRENT REPORT END DATE
SET DR=DR_";.08///"_$PIECE(BGP0,U,6)
+17 ;PREVIOUS YEAR BEGIN DATE
SET DR=DR_";.09///"_$PIECE(BGP0,U,7)
+18 ;PREVIOUS YEAR END DATE
SET DR=DR_";.1///"_$PIECE(BGP0,U,8)
+19 ;BASELINE YEAR BEGIN DATE
SET DR=DR_";.11///"_$PIECE(BGP0,U,9)
+20 ;BASELINE YEAR END DATE
SET DR=DR_";.12///"_$PIECE(BGP0,U,10)
+21 ;CURRENT NUMERATOR
SET DR=DR_";.13///"_$PIECE(BGPDATA,U)
+22 ;CURRENT DENOMINATOR
SET DR=DR_";.14///"_$PIECE(BGPDATA,U,2)
+23 ;CURRENT PERCENT
SET DR=DR_";.15///"_$PIECE(BGPDATA,U,3)
+24 ;PREVIOUS NUMERATOR
SET DR=DR_";.16///"_$PIECE(BGPDATA,U,4)
+25 ;PREVIOUS DENOMINATOR
SET DR=DR_";.17///"_$PIECE(BGPDATA,U,5)
+26 ;PREVIOUS PERCENT
SET DR=DR_";.18///"_$PIECE(BGPDATA,U,6)
+27 ;BASELINE NUMERATOR
SET DR=DR_";.19///"_$PIECE(BGPDATA,U,7)
+28 ;BASELINE DENOMINATOR
SET DR=DR_";.2///"_$PIECE(BGPDATA,U,8)
+29 ;BASELINE PERCENT
SET DR=DR_";.21///"_$PIECE(BGPDATA,U,9)
+30 DO ^DIE
+31 QUIT
ADD(BZIND,BGPD0) ;EP
+1 ;----- ADD NEW ENTRY
+2 ;
+3 NEW DA,DD,DIC,DIE,DLAYGO,DO,DR,X,Y
+4 ;
+5 SET X=BGPIND
+6 SET DIC="^BGPGP1RD("
+7 SET DIC(0)=""
+8 SET DLAYGO=90245.1
+9 DO FILE^DICN
+10 SET BGPD0=+Y
+11 ;
+12 QUIT
READ(BGPPATH,BGPFILE,BGPOUT) ;
+1 ;----- READ CONTENTS OF DATA FILE AND PUT INTO ^BGPTMP GLOBAL
+2 ;
+3 NEW BGPCNT,BGPEND,I,POP,X
+4 ;
+5 KILL ^TMP("BGPGP1RD",$JOB,BGPFILE)
+6 SET BGPOUT=0
+7 SET BGPEND=0
+8 SET BGPCNT=0
+9 ;W !,"READING FILE "_BGPPATH_BGPFILE_" ..."
+10 DO OPEN^%ZISH("FILE",BGPPATH,BGPFILE,"R")
+11 IF POP
Begin DoDot:1
+12 WRITE !?5,"UNABLE TO OPEN FILE '"_BGPPATH_BGPFILE_"'"
+13 SET BGPOUT=1
End DoDot:1
+14 IF BGPOUT
QUIT
+15 FOR I=1:1
Begin DoDot:1
+16 USE IO
READ X:DTIME
+17 IF $$STATUS^%ZISH
SET BGPEND=1
+18 IF BGPEND
QUIT
+19 SET BGPCNT=BGPCNT+1
+20 SET ^TMP("BGPGP1RD",$JOB,"FILE",I,0)=X
+21 SET ^TMP("BGPGP1RD",$JOB,"FILE",0)=BGPCNT
+22 IF '(BGPCNT#100)
USE 0
WRITE "."
End DoDot:1
IF BGPEND
QUIT
+23 ;
+24 DO CLOSE^%ZISH("FILE")
+25 QUIT
PATH(BGPPATH,BGPOUT) ;
+1 ;----- PROMPT FOR DIRECTORY PATH WHERE DATA FILE RESIDES
+2 ;
+3 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
+4 ;
+5 SET BGPPATH=""
+6 SET BGPOUT=0
+7 SET DIR(0)="FA"
+8 SET DIR("A")="Select DIRECTORY: "
+9 SET DIR("?")="Enter the PATH or DIRECTORY where the data file resides, e.g., D:\EXPORT\"
+10 DO ^DIR
+11 IF $DATA(DTOUT)!($DATA(DIRUT))!($DATA(DUOUT))
SET BGPOUT=1
+12 IF BGPOUT
QUIT
+13 SET X=Y
+14 DO DF^%ZISH(.X)
+15 SET BGPPATH=X
+16 QUIT
FILE(BGPFILE,BGPOUT) ;
+1 ;----- PROMPT FOR DATA FILE
+2 ;
+3 NEW DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
+4 ;
+5 SET BGPFILE=""
+6 SET DIR(0)="FA"
+7 SET DIR("A")="Select FILE: "
+8 SET DIR("?")="Enter the name of the data file"
+9 DO ^DIR
+10 IF $DATA(DTOUT)!($DATA(DIRUT))!($DATA(DUOUT))!($DATA(DIROUT))!(Y[U)
SET BGPOUT=1
+11 IF $GET(BGPOUT)
QUIT
+12 SET BGPFILE=Y
+13 QUIT
