BCHPRDL ; IHS/TUCSON/LAB - DOWNLOAD PROVIDER DATA TO REMOTE ; [ 08/21/02 11:14 AM ]
;;1.0;IHS RPMS CHR SYSTEM;**14**;OCT 28, 1996
;
;Routine to create a file of records containing providers
;demographic information to be downloaded to a remote computer.
;See START sub-routine for explanation.
;
START ;EP
W:$D(IOF) @IOF
W !!?9,"**** DOWNLOAD PROVIDER DATA TO REMOTE ****",!!
W "This routine is to be run whenever a CHR wants to download the list of",!,"CHR's to a laptop.",!
W !,"A file of records will be created called 'chrprov.txt'."
W !,"This file will be placed in the same directory that all export"
W !,"files are placed. In most cases, that will be /usr/spool/uucppublic."
W !,"See your site manager for assistance in finding the file once it has"
W !,"been created.",!!
;
CONT ;
S DIR(0)="Y",DIR("A")="Do you wish to continue and create a download providers file",DIR("B")="N" K DA D ^DIR K DIR
G:$D(DIRUT) XIT
G:'Y XIT
ZIS ;call to xbdbque
D XIT
QUEUE ;EP
D WAIT^DICD,PROC,XIT,XIT1
Q
PROC ;
S BCHC=0
K ^CHRTMP($J,"CHR PROVIDERS")
S BCHX=0 F S BCHX=$O(^VA(200,BCHX)) Q:BCHX'=+BCHX D
.S X=$$VALI^XBDIQ1(200,BCHX,53.5)
.Q:'X
.Q:$P($G(^DIC(7,X,9999999)),U)'=53
.D TX
.Q
D WRITEF
Q
;
TX ;
S BCHY="",BCHC=BCHC+1
S $P(BCHY,"|",1)=BCHX
S $P(BCHY,"|",2)=$P($G(^VA(200,BCHX,9999999)),U,9)
S $P(BCHY,"|",3)=$P(^AUTTLOC(DUZ(2),0),U,10)
S $P(BCHY,"|",4)=DUZ(2)
S $P(BCHY,"|",5)=""
S $P(BCHY,"|",6)=""
S $P(BCHY,"|",7)=""
S X=$P(^VA(200,BCHX,0),U)
S $P(BCHY,"|",10)=$P(X,",",1)
S $P(BCHY,"|",9)=$P($P(X,",",2)," ",2)
S $P(BCHY,"|",8)=$P($P(X,",",2)," ",1)
S $P(BCHY,"|",11)=$$VAL^XBDIQ1(200,BCHX,.111)
S $P(BCHY,"|",12)=$$VAL^XBDIQ1(200,BCHX,.112)
S $P(BCHY,"|",13)=$$VAL^XBDIQ1(200,BCHX,.114)
S $P(BCHY,"|",14)=$$VAL^XBDIQ1(200,BCHX,.115)
S $P(BCHY,"|",15)=$$VAL^XBDIQ1(200,BCHX,.116)
S $P(BCHY,"|",16)=""
S $P(BCHY,"|",17)=$$VAL^XBDIQ1(200,BCHX,.131)
S $P(BCHY,"|",18)=$$VAL^XBDIQ1(200,BCHX,.134)
S ^CHRTMP($J,"CHR PROVIDERS",BCHC)=BCHY
Q
XIT ;clean up and exit
K BCHSEL,BCHHIGH,BCHDISP,BCHQUIT,BCHANS,BCHCRIT,BCHCUT,BCHGBD,BCHGDE,BCHGDS,BCHI,BCHRAR,BCHTEXT,BCHY,BCHCNT
K AMQQTAX
K BCHFOUN,BCHJD,BCHPCNT,BCHPROC,BCHR,BCHSKIP,BCHX
K D,D0,DIC,DFN,DI,DQ,J,XBFLG,Y
Q
XIT1 ;
K BCHRPT,BCHPTVS,BCHTYPE,BCHCHR,BCHFILE
Q
WRITEF ;EP - write out flat file
S XBGL="CHRTMP("_$J_",""CHR PROVIDERS"","
S XBMED="F",XBFN="chrprov.txt",XBTLE="SAVE OF PROVIDERS FOR CHR DOWNLOAD"
S XBF=0,XBQ="N",XBFLT=1,XBE=$J
W:'$D(ZTQUEUED) !!
D ^XBGSAVE
;
WRITEFX ;
W !!,$C(7),$C(7),"A TOTAL of *** ",BCHC," *** providers were downloaded.",!!
K ^CHRTMP($J,"CHR PROVIDERS")
Q
BCHPRDL ; IHS/TUCSON/LAB - DOWNLOAD PROVIDER DATA TO REMOTE ; [ 08/21/02 11:14 AM ]
+1 ;;1.0;IHS RPMS CHR SYSTEM;**14**;OCT 28, 1996
+2 ;
+3 ;Routine to create a file of records containing providers
+4 ;demographic information to be downloaded to a remote computer.
+5 ;See START sub-routine for explanation.
+6 ;
START ;EP
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !!?9,"**** DOWNLOAD PROVIDER DATA TO REMOTE ****",!!
+3 WRITE "This routine is to be run whenever a CHR wants to download the list of",!,"CHR's to a laptop.",!
+4 WRITE !,"A file of records will be created called 'chrprov.txt'."
+5 WRITE !,"This file will be placed in the same directory that all export"
+6 WRITE !,"files are placed. In most cases, that will be /usr/spool/uucppublic."
+7 WRITE !,"See your site manager for assistance in finding the file once it has"
+8 WRITE !,"been created.",!!
+9 ;
CONT ;
+1 SET DIR(0)="Y"
SET DIR("A")="Do you wish to continue and create a download providers file"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+2 IF $DATA(DIRUT)
GOTO XIT
+3 IF 'Y
GOTO XIT
ZIS ;call to xbdbque
+1 DO XIT
QUEUE ;EP
+1 DO WAIT^DICD
DO PROC
DO XIT
DO XIT1
+2 QUIT
PROC ;
+1 SET BCHC=0
+2 KILL ^CHRTMP($JOB,"CHR PROVIDERS")
+3 SET BCHX=0
FOR
SET BCHX=$ORDER(^VA(200,BCHX))
IF BCHX'=+BCHX
QUIT
Begin DoDot:1
+4 SET X=$$VALI^XBDIQ1(200,BCHX,53.5)
+5 IF 'X
QUIT
+6 IF $PIECE($GET(^DIC(7,X,9999999)),U)'=53
QUIT
+7 DO TX
+8 QUIT
End DoDot:1
+9 DO WRITEF
+10 QUIT
+11 ;
TX ;
+1 SET BCHY=""
SET BCHC=BCHC+1
+2 SET $PIECE(BCHY,"|",1)=BCHX
+3 SET $PIECE(BCHY,"|",2)=$PIECE($GET(^VA(200,BCHX,9999999)),U,9)
+4 SET $PIECE(BCHY,"|",3)=$PIECE(^AUTTLOC(DUZ(2),0),U,10)
+5 SET $PIECE(BCHY,"|",4)=DUZ(2)
+6 SET $PIECE(BCHY,"|",5)=""
+7 SET $PIECE(BCHY,"|",6)=""
+8 SET $PIECE(BCHY,"|",7)=""
+9 SET X=$PIECE(^VA(200,BCHX,0),U)
+10 SET $PIECE(BCHY,"|",10)=$PIECE(X,",",1)
+11 SET $PIECE(BCHY,"|",9)=$PIECE($PIECE(X,",",2)," ",2)
+12 SET $PIECE(BCHY,"|",8)=$PIECE($PIECE(X,",",2)," ",1)
+13 SET $PIECE(BCHY,"|",11)=$$VAL^XBDIQ1(200,BCHX,.111)
+14 SET $PIECE(BCHY,"|",12)=$$VAL^XBDIQ1(200,BCHX,.112)
+15 SET $PIECE(BCHY,"|",13)=$$VAL^XBDIQ1(200,BCHX,.114)
+16 SET $PIECE(BCHY,"|",14)=$$VAL^XBDIQ1(200,BCHX,.115)
+17 SET $PIECE(BCHY,"|",15)=$$VAL^XBDIQ1(200,BCHX,.116)
+18 SET $PIECE(BCHY,"|",16)=""
+19 SET $PIECE(BCHY,"|",17)=$$VAL^XBDIQ1(200,BCHX,.131)
+20 SET $PIECE(BCHY,"|",18)=$$VAL^XBDIQ1(200,BCHX,.134)
+21 SET ^CHRTMP($JOB,"CHR PROVIDERS",BCHC)=BCHY
+22 QUIT
XIT ;clean up and exit
+1 KILL BCHSEL,BCHHIGH,BCHDISP,BCHQUIT,BCHANS,BCHCRIT,BCHCUT,BCHGBD,BCHGDE,BCHGDS,BCHI,BCHRAR,BCHTEXT,BCHY,BCHCNT
+2 KILL AMQQTAX
+3 KILL BCHFOUN,BCHJD,BCHPCNT,BCHPROC,BCHR,BCHSKIP,BCHX
+4 KILL D,D0,DIC,DFN,DI,DQ,J,XBFLG,Y
+5 QUIT
XIT1 ;
+1 KILL BCHRPT,BCHPTVS,BCHTYPE,BCHCHR,BCHFILE
+2 QUIT
WRITEF ;EP - write out flat file
+1 SET XBGL="CHRTMP("_$JOB_",""CHR PROVIDERS"","
+2 SET XBMED="F"
SET XBFN="chrprov.txt"
SET XBTLE="SAVE OF PROVIDERS FOR CHR DOWNLOAD"
+3 SET XBF=0
SET XBQ="N"
SET XBFLT=1
SET XBE=$JOB
+4 IF '$DATA(ZTQUEUED)
WRITE !!
+5 DO ^XBGSAVE
+6 ;
WRITEFX ;
+1 WRITE !!,$CHAR(7),$CHAR(7),"A TOTAL of *** ",BCHC," *** providers were downloaded.",!!
+2 KILL ^CHRTMP($JOB,"CHR PROVIDERS")
+3 QUIT
