BGP4AU1D ; IHS/CMI/LAB - GPRA FLAT FILE DATA DUMP ;
;;14.1;IHS CLINICAL REPORTING;;MAY 29, 2014;Build 114
DESC ;----- ROUTINE DESCRIPTION
;;
;;This routine creates a text file containing the contents of
;;the GPRA FLAT FILE DATA file.
;;$$END
N I,X F I=1:1 S X=$P($T(DESC+I),";;",2) Q:X["$$END" D EN^DDIOL(X)
Q
;
EN(BGPBEGDT,BGPEND,BGPDFILE) ;EP -- MAIN ENTRY POINT
;
N %FILE,BGPD0,BGPOUT
;
S BGPOUT=0
;
D FILE(BGPEND,.%FILE,.BGPDFILE,.BGPOUT)
Q:BGPOUT
;
U %FILE
S BGPD0=0
F S BGPD0=$O(^BGPGP1RD("CBD",BGPBEGDT,BGPD0)) Q:'BGPD0 D
. S BGPDATA=$G(^BGPGP1RD(BGPD0,0))
. Q:BGPDATA']""
. F I=6:1:12 D
. . S BGPDT=$P(BGPDATA,U,I)
. . S BGPDT=$$SLDT(BGPDT)
. . S $P(BGPDATA,U,I)=BGPDT
. W !,BGPDATA
D CLOSE^%ZISH("FILE")
;
Q
SLDT(X) ;
;----- CONVERTS FM DATE TO MM/DD/YYYY
;
N Y
S Y=""
I X D
. S X=X+17000000
. S Y=$E(X,5,6)_"/"_$E(X,7,8)_"/"_$E(X,1,4)
Q Y
FILE(BGPEND,%FILE,BGPDFILE,BGPOUT) ;
;----- CREATE FILE CONTAINING THE DATA
;
N BGPERR,BGPOUT
;
;I '$G(DUZ) S DUZ=1
D ^XBKVAR
S BGPOUT=0
S BGPERR=""
S BGPDFILE="BGPGP1DD"_BGPEND_"_"_DT
D HFS(.BGPOUT,.%FILE,BGPDFILE)
I BGPOUT D Q
. S BGPERR="CANNOT OPEN FILE" ;FOR ERROR TRAP
. ;S $ZE="BGP4AU1D FAILURE" D ^%ZTER
Q
HFS(BGPOUT,%FILE,BGPDFILE) ;EP
;----- CREATE AND OPEN DATA FILE
;
; INPUT:
; FILE = DATA FILE NAME TO CREATE AND OPEN
;
; OUTPUT:
; %FILE = THE DEVICE NUMBER OF THE FILE
; BGPOUT = QUIT INDICATOR
;
N I,POP,X,Y,ZISH1,ZISH2,ZISH3,ZISH4
;
S %FILE=""
S BGPOUT=0
S ZISH1="FILE" ;HANDLE
S ZISH2=$P($G(^BGPGP1PM(1,1)),U) ;DIRECTORY
S ZISH3=BGPDFILE ;FILENAME
S ZISH4="W" ;APPEND MODE
D OPEN^%ZISH(ZISH1,ZISH2,ZISH3,ZISH4)
I POP S BGPOUT=1
Q:BGPOUT
S %FILE=IO
Q
BGP4AU1D ; IHS/CMI/LAB - GPRA FLAT FILE DATA DUMP ;
+1 ;;14.1;IHS CLINICAL REPORTING;;MAY 29, 2014;Build 114
DESC ;----- ROUTINE DESCRIPTION
+1 ;;
+2 ;;This routine creates a text file containing the contents of
+3 ;;the GPRA FLAT FILE DATA file.
+4 ;;$$END
+5 NEW I,X
FOR I=1:1
SET X=$PIECE($TEXT(DESC+I),";;",2)
IF X["$$END"
QUIT
DO EN^DDIOL(X)
+6 QUIT
+7 ;
EN(BGPBEGDT,BGPEND,BGPDFILE) ;EP -- MAIN ENTRY POINT
+1 ;
+2 NEW %FILE,BGPD0,BGPOUT
+3 ;
+4 SET BGPOUT=0
+5 ;
+6 DO FILE(BGPEND,.%FILE,.BGPDFILE,.BGPOUT)
+7 IF BGPOUT
QUIT
+8 ;
+9 USE %FILE
+10 SET BGPD0=0
+11 FOR
SET BGPD0=$ORDER(^BGPGP1RD("CBD",BGPBEGDT,BGPD0))
IF 'BGPD0
QUIT
Begin DoDot:1
+12 SET BGPDATA=$GET(^BGPGP1RD(BGPD0,0))
+13 IF BGPDATA']""
QUIT
+14 FOR I=6:1:12
Begin DoDot:2
+15 SET BGPDT=$PIECE(BGPDATA,U,I)
+16 SET BGPDT=$$SLDT(BGPDT)
+17 SET $PIECE(BGPDATA,U,I)=BGPDT
End DoDot:2
+18 WRITE !,BGPDATA
End DoDot:1
+19 DO CLOSE^%ZISH("FILE")
+20 ;
+21 QUIT
SLDT(X) ;
+1 ;----- CONVERTS FM DATE TO MM/DD/YYYY
+2 ;
+3 NEW Y
+4 SET Y=""
+5 IF X
Begin DoDot:1
+6 SET X=X+17000000
+7 SET Y=$EXTRACT(X,5,6)_"/"_$EXTRACT(X,7,8)_"/"_$EXTRACT(X,1,4)
End DoDot:1
+8 QUIT Y
FILE(BGPEND,%FILE,BGPDFILE,BGPOUT) ;
+1 ;----- CREATE FILE CONTAINING THE DATA
+2 ;
+3 NEW BGPERR,BGPOUT
+4 ;
+5 ;I '$G(DUZ) S DUZ=1
+6 DO ^XBKVAR
+7 SET BGPOUT=0
+8 SET BGPERR=""
+9 SET BGPDFILE="BGPGP1DD"_BGPEND_"_"_DT
+10 DO HFS(.BGPOUT,.%FILE,BGPDFILE)
+11 IF BGPOUT
Begin DoDot:1
+12 ;FOR ERROR TRAP
SET BGPERR="CANNOT OPEN FILE"
+13 ;S $ZE="BGP4AU1D FAILURE" D ^%ZTER
End DoDot:1
QUIT
+14 QUIT
HFS(BGPOUT,%FILE,BGPDFILE) ;EP
+1 ;----- CREATE AND OPEN DATA FILE
+2 ;
+3 ; INPUT:
+4 ; FILE = DATA FILE NAME TO CREATE AND OPEN
+5 ;
+6 ; OUTPUT:
+7 ; %FILE = THE DEVICE NUMBER OF THE FILE
+8 ; BGPOUT = QUIT INDICATOR
+9 ;
+10 NEW I,POP,X,Y,ZISH1,ZISH2,ZISH3,ZISH4
+11 ;
+12 SET %FILE=""
+13 SET BGPOUT=0
+14 ;HANDLE
SET ZISH1="FILE"
+15 ;DIRECTORY
SET ZISH2=$PIECE($GET(^BGPGP1PM(1,1)),U)
+16 ;FILENAME
SET ZISH3=BGPDFILE
+17 ;APPEND MODE
SET ZISH4="W"
+18 DO OPEN^%ZISH(ZISH1,ZISH2,ZISH3,ZISH4)
+19 IF POP
SET BGPOUT=1
+20 IF BGPOUT
QUIT
+21 SET %FILE=IO
+22 QUIT
