- 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
