BGP4AU1A ; IHS/CMI/LAB - BUILD CRS* FILES ;
;;14.1;IHS CLINICAL REPORTING;;MAY 29, 2014;Build 114
;
DESC ;----- ROUTINE DESCRIPTION
;;
;;This routine creates the 5 CRS* files from data uploaded
;;from the sites contained in the BGP 11 DATA CURRENT, BGP
;;11 DATA BASELINE and BGP 11 DATA PREVIOUS files.
;;$$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,BGPENDDT,BGPEND,BGPAUF) ;EP
;EP -- MAIN ENTRY POINT
;
; INPUT:
; BGPBEGDT = BEGIN DATE OF BGP 11 DATA FILE ENTRIES
;
N BGPPTYPE,BGPRTYPE,BGPBD,BGPED,BGPPBD,BGPPED,BGPBBD,BGPBED,BGPDELT
N BGPNODEL,BGPAREAA,BGPEXCEL,BGPRPT,BGPROT,BGPINDJ,BGPUF,BGPSUL,BGPF
N BGPNOW,BGPASUF,X,BGPC
;
D ^XBKVAR
D HOME^%ZIS
;
;SET SOME VARIABLES NEEDED BY THE BGP* ROUTINES:
S (BGPPTYPE,BGPRTYPE,BGPBD,BGPED,BGPIC,BGPPBD,BGPPED,BGPBBD,BGPBED,BGPDELT)=""
S BGPNODEL=1 ;USED IN BGP4PARP SO IT WON'T DO SAVEDEL^BGP4PDL
S BGPAREAA=1
S BGPEXCEL=1
S BGPRPT=0
S BGPROT="D"
S BGPINDJ="G"
S BGPUF=$P($G(^BGPGP1PM(1,1)),U)
Q:BGPUF']""
;
D SUL(BGPBEGDT,.BGPEND,.BGPSUL)
Q:'$D(BGPSUL)
S BGPC=0,X=0 F S X=$O(BGPSUL(X)) Q:X'=+X S BGPC=BGPC+1
S BGPEND=BGPEND+17000000
;
S BGPNOW=$$NOW^XLFDT()
S BGPNOW=$P(BGPNOW,".")_"."_$$RZERO^BGP4UTL($P(BGPNOW,".",2),6)
;
S BGPASUF=$P(^AUTTLOC(DUZ(2),0),U,10)
;
S X=0 F S X=$O(^BGPINDJ("GPRA",1,X)) Q:X'=+X S BGPIND(X)=""
;
S X=".TXT"
S (BGPAUF(1),BGPFGNT1)="BGPGP"_BGPEND_"CRSGPRANT1"_X
S (BGPAUF(2),BGPFGNT2)="BGPGP"_BGPEND_"CRSGPRANT2"_X
S (BGPAUF(3),BGPFGNT2)="BGPGP"_BGPEND_"CRSGPRANT3"_X
S (BGPAUF(4),BGPFDEV1)="BGPGP"_BGPEND_"CRSGPRADEVNT1"_X
S (BGPAUF(5),BGPFDEV2)="BGPGP"_BGPEND_"CRSGPRADEVNT2"_X
S (BGPAUF(6),BGPFDEV3)="BGPGP"_BGPEND_"CRSGPRADEVNT3"_X
S (BGPAUF(7),BGPFDEV4)="BGPGP"_BGPEND_"CRSGPRADEVNT4"_X
;
S BGPAUEX=1
D SETEXCEL^BGP4DP
D PRINT^BGP4PARP
D GNT1^BGP4UTL
S X=".TXT"
;now do it again with different filenames
K BGPEI,BGPEI2,BGPEIDV1,BGPEIDV2,BGPEIDV3,BGPONN1,BGPONN2,BGPONN3,BGPONN4,BGPONN5
S BGPFGNT1="CRSGPRANT1"_$P(^AUTTLOC(DUZ(2),0),U,10)_BGPEND_$$D^BGP4UTL(BGPNOW)_"_"_$$LZERO^BGP4UTL(BGPC,6)_".TXT"
S BGPFGNT2="CRSGPRANT2"_$P(^AUTTLOC(DUZ(2),0),U,10)_BGPEND_$$D^BGP4UTL(BGPNOW)_"_"_$$LZERO^BGP4UTL(BGPC,6)_".TXT"
S BGPFGNT3="CRSGPRANT3"_$P(^AUTTLOC(DUZ(2),0),U,10)_BGPEND_$$D^BGP4UTL(BGPNOW)_"_"_$$LZERO^BGP4UTL(BGPC,6)_".TXT"
S BGPFDEV1="CRSGPRADEVNT1"_$P(^AUTTLOC(DUZ(2),0),U,10)_BGPEND_$$D^BGP4UTL(BGPNOW)_"_"_$$LZERO^BGP4UTL(BGPC,6)_".TXT"
S BGPFDEV2="CRSGPRADEVNT2"_$P(^AUTTLOC(DUZ(2),0),U,10)_BGPEND_$$D^BGP4UTL(BGPNOW)_"_"_$$LZERO^BGP4UTL(BGPC,6)_".TXT"
S BGPFDEV3="CRSGPRADEVNT3"_$P(^AUTTLOC(DUZ(2),0),U,10)_BGPEND_$$D^BGP4UTL(BGPNOW)_"_"_$$LZERO^BGP4UTL(BGPC,6)_".TXT"
S BGPFDEV4="CRSGPRADEVNT4"_$P(^AUTTLOC(DUZ(2),0),U,10)_BGPEND_$$D^BGP4UTL(BGPNOW)_"_"_$$LZERO^BGP4UTL(BGPC,6)_".TXT"
;
S BGPAUEX=1
D SETEXCEL^BGP4DP
D PRINT^BGP4PARP
D GNT1^BGP4UTL
D KILL
Q
SUL(BGPBEGDT,BGPEND,BGPSUL) ;
;----- RETURNS BGPSUL ARRAY CONTAINING ENTRIES FROM
; BGP 11 DATA FILE CONTAINING THE BEGINNING DATE
;
; INPUT:
; BGPBEGDT = BEGIN DATE
;
N BGPD0
;
S BGPD0=0
F S BGPD0=$O(^BGPGPDCJ("B",BGPBEGDT,BGPD0)) Q:'BGPD0 D
. S BGPSUL(BGPD0)=""
. S BGPEND=$P($G(^BGPGPDCJ(BGPD0,0)),U,2)
Q
KILL ;KILL VARIABLES SET BY BGP* ROUTINES
;
K A,B,BGPA,BGPBLD,BGPBLN,BGPBLP,BGPC,BGPCHSN,BGPCHSO,BGPCYD
K BGPCYN,BGPCYP,BGPDAB,BGPDAC,BGPDAP,BGPDENP,BGPDF,BGPEC
K BGPGPG,BGPHD1,BGPHD2,BGPHPG,BGPIC,BGPIFTR,BGPIIDEL,BGPIND
K BGPIOSL,BGPLCNT,BGPNF,BGPNODE,BGPNP,BGPONN1,BGPONN2,BGPONN3
K BGPONN4,BGPORDP,BGPORDP1,BGPORDSE,BGPORXX,BGPP,BGPPC,BGPPC1
K BGPPC2,BGPPP1,BGPPRD,BGPPRN,BGPPRP,BGPQHDR,BGPQUIT,BGPSDPD
K BGPURBN,BGPURBO,BGPX,BGPX1,BGPXN,BGPXX,BGPXY,BGPY,BGPZ,C,D,E
K F,G,H,I,L,N,O,P,V,Y
Q
BGP4AU1A ; IHS/CMI/LAB - BUILD CRS* FILES ;
+1 ;;14.1;IHS CLINICAL REPORTING;;MAY 29, 2014;Build 114
+2 ;
DESC ;----- ROUTINE DESCRIPTION
+1 ;;
+2 ;;This routine creates the 5 CRS* files from data uploaded
+3 ;;from the sites contained in the BGP 11 DATA CURRENT, BGP
+4 ;;11 DATA BASELINE and BGP 11 DATA PREVIOUS files.
+5 ;;$$END
+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
+8 ;
EN(BGPBEGDT,BGPENDDT,BGPEND,BGPAUF) ;EP
+1 ;EP -- MAIN ENTRY POINT
+2 ;
+3 ; INPUT:
+4 ; BGPBEGDT = BEGIN DATE OF BGP 11 DATA FILE ENTRIES
+5 ;
+6 NEW BGPPTYPE,BGPRTYPE,BGPBD,BGPED,BGPPBD,BGPPED,BGPBBD,BGPBED,BGPDELT
+7 NEW BGPNODEL,BGPAREAA,BGPEXCEL,BGPRPT,BGPROT,BGPINDJ,BGPUF,BGPSUL,BGPF
+8 NEW BGPNOW,BGPASUF,X,BGPC
+9 ;
+10 DO ^XBKVAR
+11 DO HOME^%ZIS
+12 ;
+13 ;SET SOME VARIABLES NEEDED BY THE BGP* ROUTINES:
+14 SET (BGPPTYPE,BGPRTYPE,BGPBD,BGPED,BGPIC,BGPPBD,BGPPED,BGPBBD,BGPBED,BGPDELT)=""
+15 ;USED IN BGP4PARP SO IT WON'T DO SAVEDEL^BGP4PDL
SET BGPNODEL=1
+16 SET BGPAREAA=1
+17 SET BGPEXCEL=1
+18 SET BGPRPT=0
+19 SET BGPROT="D"
+20 SET BGPINDJ="G"
+21 SET BGPUF=$PIECE($GET(^BGPGP1PM(1,1)),U)
+22 IF BGPUF']""
QUIT
+23 ;
+24 DO SUL(BGPBEGDT,.BGPEND,.BGPSUL)
+25 IF '$DATA(BGPSUL)
QUIT
+26 SET BGPC=0
SET X=0
FOR
SET X=$ORDER(BGPSUL(X))
IF X'=+X
QUIT
SET BGPC=BGPC+1
+27 SET BGPEND=BGPEND+17000000
+28 ;
+29 SET BGPNOW=$$NOW^XLFDT()
+30 SET BGPNOW=$PIECE(BGPNOW,".")_"."_$$RZERO^BGP4UTL($PIECE(BGPNOW,".",2),6)
+31 ;
+32 SET BGPASUF=$PIECE(^AUTTLOC(DUZ(2),0),U,10)
+33 ;
+34 SET X=0
FOR
SET X=$ORDER(^BGPINDJ("GPRA",1,X))
IF X'=+X
QUIT
SET BGPIND(X)=""
+35 ;
+36 SET X=".TXT"
+37 SET (BGPAUF(1),BGPFGNT1)="BGPGP"_BGPEND_"CRSGPRANT1"_X
+38 SET (BGPAUF(2),BGPFGNT2)="BGPGP"_BGPEND_"CRSGPRANT2"_X
+39 SET (BGPAUF(3),BGPFGNT2)="BGPGP"_BGPEND_"CRSGPRANT3"_X
+40 SET (BGPAUF(4),BGPFDEV1)="BGPGP"_BGPEND_"CRSGPRADEVNT1"_X
+41 SET (BGPAUF(5),BGPFDEV2)="BGPGP"_BGPEND_"CRSGPRADEVNT2"_X
+42 SET (BGPAUF(6),BGPFDEV3)="BGPGP"_BGPEND_"CRSGPRADEVNT3"_X
+43 SET (BGPAUF(7),BGPFDEV4)="BGPGP"_BGPEND_"CRSGPRADEVNT4"_X
+44 ;
+45 SET BGPAUEX=1
+46 DO SETEXCEL^BGP4DP
+47 DO PRINT^BGP4PARP
+48 DO GNT1^BGP4UTL
+49 SET X=".TXT"
+50 ;now do it again with different filenames
+51 KILL BGPEI,BGPEI2,BGPEIDV1,BGPEIDV2,BGPEIDV3,BGPONN1,BGPONN2,BGPONN3,BGPONN4,BGPONN5
+52 SET BGPFGNT1="CRSGPRANT1"_$PIECE(^AUTTLOC(DUZ(2),0),U,10)_BGPEND_$$D^BGP4UTL(BGPNOW)_"_"_$$LZERO^BGP4UTL(BGPC,6)_".TXT"
+53 SET BGPFGNT2="CRSGPRANT2"_$PIECE(^AUTTLOC(DUZ(2),0),U,10)_BGPEND_$$D^BGP4UTL(BGPNOW)_"_"_$$LZERO^BGP4UTL(BGPC,6)_".TXT"
+54 SET BGPFGNT3="CRSGPRANT3"_$PIECE(^AUTTLOC(DUZ(2),0),U,10)_BGPEND_$$D^BGP4UTL(BGPNOW)_"_"_$$LZERO^BGP4UTL(BGPC,6)_".TXT"
+55 SET BGPFDEV1="CRSGPRADEVNT1"_$PIECE(^AUTTLOC(DUZ(2),0),U,10)_BGPEND_$$D^BGP4UTL(BGPNOW)_"_"_$$LZERO^BGP4UTL(BGPC,6)_".TXT"
+56 SET BGPFDEV2="CRSGPRADEVNT2"_$PIECE(^AUTTLOC(DUZ(2),0),U,10)_BGPEND_$$D^BGP4UTL(BGPNOW)_"_"_$$LZERO^BGP4UTL(BGPC,6)_".TXT"
+57 SET BGPFDEV3="CRSGPRADEVNT3"_$PIECE(^AUTTLOC(DUZ(2),0),U,10)_BGPEND_$$D^BGP4UTL(BGPNOW)_"_"_$$LZERO^BGP4UTL(BGPC,6)_".TXT"
+58 SET BGPFDEV4="CRSGPRADEVNT4"_$PIECE(^AUTTLOC(DUZ(2),0),U,10)_BGPEND_$$D^BGP4UTL(BGPNOW)_"_"_$$LZERO^BGP4UTL(BGPC,6)_".TXT"
+59 ;
+60 SET BGPAUEX=1
+61 DO SETEXCEL^BGP4DP
+62 DO PRINT^BGP4PARP
+63 DO GNT1^BGP4UTL
+64 DO KILL
+65 QUIT
SUL(BGPBEGDT,BGPEND,BGPSUL) ;
+1 ;----- RETURNS BGPSUL ARRAY CONTAINING ENTRIES FROM
+2 ; BGP 11 DATA FILE CONTAINING THE BEGINNING DATE
+3 ;
+4 ; INPUT:
+5 ; BGPBEGDT = BEGIN DATE
+6 ;
+7 NEW BGPD0
+8 ;
+9 SET BGPD0=0
+10 FOR
SET BGPD0=$ORDER(^BGPGPDCJ("B",BGPBEGDT,BGPD0))
IF 'BGPD0
QUIT
Begin DoDot:1
+11 SET BGPSUL(BGPD0)=""
+12 SET BGPEND=$PIECE($GET(^BGPGPDCJ(BGPD0,0)),U,2)
End DoDot:1
+13 QUIT
KILL ;KILL VARIABLES SET BY BGP* ROUTINES
+1 ;
+2 KILL A,B,BGPA,BGPBLD,BGPBLN,BGPBLP,BGPC,BGPCHSN,BGPCHSO,BGPCYD
+3 KILL BGPCYN,BGPCYP,BGPDAB,BGPDAC,BGPDAP,BGPDENP,BGPDF,BGPEC
+4 KILL BGPGPG,BGPHD1,BGPHD2,BGPHPG,BGPIC,BGPIFTR,BGPIIDEL,BGPIND
+5 KILL BGPIOSL,BGPLCNT,BGPNF,BGPNODE,BGPNP,BGPONN1,BGPONN2,BGPONN3
+6 KILL BGPONN4,BGPORDP,BGPORDP1,BGPORDSE,BGPORXX,BGPP,BGPPC,BGPPC1
+7 KILL BGPPC2,BGPPP1,BGPPRD,BGPPRN,BGPPRP,BGPQHDR,BGPQUIT,BGPSDPD
+8 KILL BGPURBN,BGPURBO,BGPX,BGPX1,BGPXN,BGPXX,BGPXY,BGPY,BGPZ,C,D,E
+9 KILL F,G,H,I,L,N,O,P,V,Y
+10 QUIT
