Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BGP6AU1R

BGP6AU1R.m

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