- BGP5AU1D ; IHS/CMI/LAB - GPRA FLAT FILE DATA DUMP ;
- ;;15.1;IHS CLINICAL REPORTING;;MAY 06, 2015;Build 143
- 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="BGP5AU1D 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
- BGP5AU1D ; IHS/CMI/LAB - GPRA FLAT FILE DATA DUMP ;
- +1 ;;15.1;IHS CLINICAL REPORTING;;MAY 06, 2015;Build 143
- 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="BGP5AU1D 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
