BCHDLA.m

BCHDLA ; IHS/TUCSON/LAB - DOWNLOAD PATIENT DATA TO REMOTE ;  [ 06/17/02  7:27 AM ]

 ;;1.0;IHS RPMS CHR SYSTEM;**16**;OCT 28, 1996

 ;

 ;Routine to create a file of records containing patient 

 ;demographic information to be downloaded to a remote computer.

 ;See START sub-routine for explanation.

 ;

START ;EP

 W:$D(IOF) @IOF

 W !!?9,"**** DOWNLOAD NEW AND CHANGED PATIENT DEMOGRAPHIC DATA TO REMOTE ****",!!

 W !,"This option is used to download new and changed patient demographic"

 W !,"data to the CHR remote computer. This routine is to be run"

 W !,"periodically and in coordination with the CHR program."

 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.",!!,"Once you get the file it needs to be forwarded"

 W !,"to the CHR."

 ;

 S BCHDLDT=$P($G(^BCHSITE(DUZ(2),0)),U,15)

 I BCHDLDT="" W !!,"A first time patient download has never been done for" D  D XIT Q

 .W !,$P(^DIC(4,DUZ(2),0),U)," before.  Please use the first time download"

 .W !,"option to download the patient data."

 W !!!,"Patients entered or changed after "_$$FMTE^XLFDT($P($G(^BCHSITE(DUZ(2),0)),U,15))," will be downloaded.",!

CONT ;

 K DIR S DIR(0)="Y",DIR("A")="Do you wish to continue and create a download patient file",DIR("B")="N" K DA D ^DIR K DIR

 G:$D(DIRUT) XIT

 G:'Y XIT

FACHRN ;

 ;W !!

 ;W !,"Only patients who have an HRN at the facility you select below will",!,"be downloaded.",!

 ;S DIC=9999999.06,DIC(0)="AEMQ",DIC("A")="Which FACILITY's HRN should pass to the remote?  ",DIC("B")=$P(^DIC(4,DUZ(2),0),U) D ^DIC K DIC,DA,DR

 ;I Y=-1 G START

 ;S BCHFAC=+Y

CHR ;

 ;S BCHCHR=""

 ;S DIR(0)="90002,.03",DIR("A")="For which CHR is the file being created" K DA D ^DIR K DIR

 ;G:$D(DIRUT) XIT

 ;I Y="" G XIT

 ;S BCHCHR=+Y

ADD ;

 D ADD1^BCHRL01

 I $D(BCHQUIT) G XIT

 D SCREEN

 I $D(BCHQUIT) D DEL^BCHRL G XIT

CONFIRM ;

 W !!,"The file(s) created will be placed in the ",$S($P(^AUTTSITE(1,0),U,21)=1:"/usr/spool/uucppublic",1:"C:\EXPORT")," directory."

 W !,"The file will be called:  ",BCHFILE,!

 W !!,"It may be several hours (or overnight) before your flat file is finished.",!

 W !,"As a reminder, the records that are generated and placed in the file(s)"

 W !,"are in a standard, pre-defined record format.  For a definition of the format",!,"please see your user manual.",!

 K DIR S DIR(0)="Y",DIR("A")="Is everything ok?  Do you want to continue",DIR("B")="Y" K DA D ^DIR K DIR

 I $D(DIRUT)!(Y'=1) S BCHQUIT=1 G XIT

 S DA=BCHRPT,DR=".12///"_BCHFILE,DIE="^BCHTRPT(" D ^DIE

 K DIE,DA,DR

ZIS ;call to xbdbque

 D XIT

QUEUE ;EP

 K ZTSK

 S DIR(0)="Y",DIR("A")="Do you want to QUEUE this to run at a later time",DIR("B")="Y" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I Y=1 D QUEUE1,XIT,XIT1 Q

 I $D(DIRUT) W !,"Okay .. you '^'ed or timed out ..Goodbye" D XIT,XIT1 Q

 D WAIT^DICD,^BCHDLA1,XIT,XIT1

 Q

QUEUE1 ;

 S XBRC="^BCHDLA1",XBRX="XIT^BCHDLA",XBNS="BCH;IO*",XBIOP="HOME",XBFQ=1

 D ^XBDBQUE

 D XIT,XIT1

 Q

SCREEN ;EP

 S X2=$E(DT,1,3)_"0101",X1=DT D ^%DTC S BCHJD=X+1

 S BCHPTVS="P",BCHTYPE="P",BCHFILE="bchpts"_$TR($$NOW^XLFDT,".","")_".txt"

 D SMENU

 S DIR(0)="LO^1:"_BCHHIGH,DIR("A")="Select Patients based on which of the above" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 G:Y="" XIT

 I $D(DIRUT) G XIT

 ;process all items in Y

 D SELECT^BCHRL0

 D SHOW^BCHRLS

 W !! S DIR(0)="Y",DIR("A")="      Would you like to select additional "_$S(BCHPTVS="P":"PATIENT",1:"CHR RECORD")_" criteria",DIR("B")="NO" D ^DIR K DIR

 S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) S BCHQUIT=1 Q

 Q:Y=0

 G SCREEN

 ;

SMENU ;EP

 K BCHDISP,BCHSEL,BCHHIGH

 I $Y>(IOSL-8) W:$D(IOF) @IOF

 W !!,"The Patients downloaded can be selected based on any of the following criteria:",!

 S BCHHIGH=0,X=0 F  S X=$O(^BCHSORT("AD",1,X)) Q:X'=+X  S BCHHIGH=BCHHIGH+1,BCHSEL(BCHHIGH)=X

 S BCHCUT=((BCHHIGH/2)+.5)\1

 S I=0,J=1 F  S I=$O(BCHSEL(I)) Q:I'=+I!($D(BCHDISP(I)))  D

  .W !?5,I,") ",$E($P(^BCHSORT(BCHSEL(I),0),U),1,30) S BCHDISP(I)=""

 .S J=I+BCHCUT I $D(BCHSEL(J)),'$D(BCHDISP(J)) W ?40,J,") ",$E($P(^BCHSORT(BCHSEL(J),0),U),1,30) S BCHDISP(J)=""

 W !!?9,"<Enter a list or a range.  E.g. 1-4,5,20 or 10,12,20,30>"

 W !?9,"<<HIT RETURN to conclude selections or bypass screens>>"

 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

BCHDLA    ; IHS/TUCSON/LAB - DOWNLOAD PATIENT DATA TO REMOTE ;  [ 06/17/02  7:27 AM ]

 +1       ;;1.0;IHS RPMS CHR SYSTEM;**16**;OCT 28, 1996

 +2       ;

 +3       ;Routine to create a file of records containing patient 

 +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 NEW AND CHANGED PATIENT DEMOGRAPHIC DATA TO REMOTE ****",!!

 +3        WRITE !,"This option is used to download new and changed patient demographic"

 +4        WRITE !,"data to the CHR remote computer. This routine is to be run"

 +5        WRITE !,"periodically and in coordination with the CHR program."

 +6        WRITE !,"This file will be placed in the same directory that all export"

 +7        WRITE !,"files are placed.  In most cases, that will be /usr/spool/uucppublic."

 +8        WRITE !,"See your site manager for assistance in finding the file once it has"

 +9        WRITE !,"been created.",!!,"Once you get the file it needs to be forwarded"

 +10       WRITE !,"to the CHR."

 +11      ;

 +12       SET BCHDLDT=$PIECE($GET(^BCHSITE(DUZ(2),0)),U,15)

 +13       IF BCHDLDT=""

               WRITE !!,"A first time patient download has never been done for"

               Begin DoDot:1

 +14               WRITE !,$PIECE(^DIC(4,DUZ(2),0),U)," before.  Please use the first time download"

 +15               WRITE !,"option to download the patient data."

               End DoDot:1

               DO XIT

               QUIT 

 +16       WRITE !!!,"Patients entered or changed after "_$$FMTE^XLFDT($PIECE($GET(^BCHSITE(DUZ(2),0)),U,15))," will be downloaded.",!

CONT      ;

 +1        KILL DIR

           SET DIR(0)="Y"

           SET DIR("A")="Do you wish to continue and create a download patient file"

           SET DIR("B")="N"

           KILL DA

           DO ^DIR

           KILL DIR

 +2        IF $DATA(DIRUT)

               GOTO XIT

 +3        IF 'Y

               GOTO XIT

FACHRN    ;

 +1       ;W !!

 +2       ;W !,"Only patients who have an HRN at the facility you select below will",!,"be downloaded.",!

 +3       ;S DIC=9999999.06,DIC(0)="AEMQ",DIC("A")="Which FACILITY's HRN should pass to the remote?  ",DIC("B")=$P(^DIC(4,DUZ(2),0),U) D ^DIC K DIC,DA,DR

 +4       ;I Y=-1 G START

 +5       ;S BCHFAC=+Y

CHR       ;

 +1       ;S BCHCHR=""

 +2       ;S DIR(0)="90002,.03",DIR("A")="For which CHR is the file being created" K DA D ^DIR K DIR

 +3       ;G:$D(DIRUT) XIT

 +4       ;I Y="" G XIT

 +5       ;S BCHCHR=+Y

ADD       ;

 +1        DO ADD1^BCHRL01

 +2        IF $DATA(BCHQUIT)

               GOTO XIT

 +3        DO SCREEN

 +4        IF $DATA(BCHQUIT)

               DO DEL^BCHRL

               GOTO XIT

CONFIRM   ;

 +1        WRITE !!,"The file(s) created will be placed in the ",$SELECT($PIECE(^AUTTSITE(1,0),U,21)=1:"/usr/spool/uucppublic",1:"C:\EXPORT")," directory."

 +2        WRITE !,"The file will be called:  ",BCHFILE,!

 +3        WRITE !!,"It may be several hours (or overnight) before your flat file is finished.",!

 +4        WRITE !,"As a reminder, the records that are generated and placed in the file(s)"

 +5        WRITE !,"are in a standard, pre-defined record format.  For a definition of the format",!,"please see your user manual.",!

 +6        KILL DIR

           SET DIR(0)="Y"

           SET DIR("A")="Is everything ok?  Do you want to continue"

           SET DIR("B")="Y"

           KILL DA

           DO ^DIR

           KILL DIR

 +7        IF $DATA(DIRUT)!(Y'=1)

               SET BCHQUIT=1

               GOTO XIT

 +8        SET DA=BCHRPT

           SET DR=".12///"_BCHFILE

           SET DIE="^BCHTRPT("

           DO ^DIE

 +9        KILL DIE,DA,DR

ZIS       ;call to xbdbque

 +1        DO XIT

QUEUE     ;EP

 +1        KILL ZTSK

 +2        SET DIR(0)="Y"

           SET DIR("A")="Do you want to QUEUE this to run at a later time"

           SET DIR("B")="Y"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +3        IF Y=1

               DO QUEUE1

               DO XIT

               DO XIT1

               QUIT 

 +4        IF $DATA(DIRUT)

               WRITE !,"Okay .. you '^'ed or timed out ..Goodbye"

               DO XIT

               DO XIT1

               QUIT 

 +5        DO WAIT^DICD

           DO ^BCHDLA1

           DO XIT

           DO XIT1

 +6        QUIT 

QUEUE1    ;

 +1        SET XBRC="^BCHDLA1"

           SET XBRX="XIT^BCHDLA"

           SET XBNS="BCH;IO*"

           SET XBIOP="HOME"

           SET XBFQ=1

 +2        DO ^XBDBQUE

 +3        DO XIT

           DO XIT1

 +4        QUIT 

SCREEN    ;EP

 +1        SET X2=$EXTRACT(DT,1,3)_"0101"

           SET X1=DT

           DO ^%DTC

           SET BCHJD=X+1

 +2        SET BCHPTVS="P"

           SET BCHTYPE="P"

           SET BCHFILE="bchpts"_$TRANSLATE($$NOW^XLFDT,".","")_".txt"

 +3        DO SMENU

 +4        SET DIR(0)="LO^1:"_BCHHIGH

           SET DIR("A")="Select Patients based on which of the above"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +5        IF Y=""

               GOTO XIT

 +6        IF $DATA(DIRUT)

               GOTO XIT

 +7       ;process all items in Y

 +8        DO SELECT^BCHRL0

 +9        DO SHOW^BCHRLS

 +10       WRITE !!

           SET DIR(0)="Y"

           SET DIR("A")="      Would you like to select additional "_$SELECT(BCHPTVS="P":"PATIENT",1:"CHR RECORD")_" criteria"

           SET DIR("B")="NO"

           DO ^DIR

           KILL DIR

 +11       IF $DATA(DUOUT)

               SET DIRUT=1

 +12       IF $DATA(DIRUT)

               SET BCHQUIT=1

               QUIT 

 +13       IF Y=0

               QUIT 

 +14       GOTO SCREEN

 +15      ;

SMENU     ;EP

 +1        KILL BCHDISP,BCHSEL,BCHHIGH

 +2        IF $Y>(IOSL-8)

               IF $DATA(IOF)

                   WRITE @IOF

 +3        WRITE !!,"The Patients downloaded can be selected based on any of the following criteria:",!

 +4        SET BCHHIGH=0

           SET X=0

           FOR 

               SET X=$ORDER(^BCHSORT("AD",1,X))

               IF X'=+X

                   QUIT 

               SET BCHHIGH=BCHHIGH+1

               SET BCHSEL(BCHHIGH)=X

 +5        SET BCHCUT=((BCHHIGH/2)+.5)\1

 +6        SET I=0

           SET J=1

           FOR 

               SET I=$ORDER(BCHSEL(I))

               IF I'=+I!($DATA(BCHDISP(I)))

                   QUIT 

               Begin DoDot:1

 +7                WRITE !?5,I,") ",$EXTRACT($PIECE(^BCHSORT(BCHSEL(I),0),U),1,30)

                   SET BCHDISP(I)=""

 +8                SET J=I+BCHCUT

                   IF $DATA(BCHSEL(J))

                       IF '$DATA(BCHDISP(J))

                           WRITE ?40,J,") ",$EXTRACT($PIECE(^BCHSORT(BCHSEL(J),0),U),1,30)

                           SET BCHDISP(J)=""

               End DoDot:1

 +9        WRITE !!?9,"<Enter a list or a range.  E.g. 1-4,5,20 or 10,12,20,30>"

 +10       WRITE !?9,"<<HIT RETURN to conclude selections or bypass screens>>"

 +11       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