Routine: BCHDCOMM

BCHDCOMM ; IHS/CMI/LAB - COMMUNITY DOWNLOAD ROUTINE ;

 ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27

 ;Generates COMMUNITY file for uploading onto the remote

 ;computer systems.

EP ;

 W:$D(IOF) @IOF

 W !!,"This utility routine is used to download, by Area, all communities in the",!,"COMMUNITY file to the remote computer."

 W !!,"You will be asked to enter your Area.  A unix file will be created",!,"called communit.imp.  It must be then put in the C:\CHR directory on the ",!,"remote and uploaded into that machine.",!!

 S C=0

 K ^XTMP("BCH COMMUNITIES",$J)

 S ^XTMP("BCH COMMUNITIES",0)=$$FMADD^XLFDT(DT,14)_U_DT_"CHR DOWNLOAD"

 D AREA

 Q:'BCHQ

 D COMM

 D WRITEF

 D XIT

 ;---------------------------------------------

AREA ;select desired area

 S BCHQ=1

 S DIC="^AUTTAREA(",DIC(0)="AEMQ" D ^DIC

 I Y=-1 W:'$D(^XTMP("BCH COMMUNITIES")) !!,"NO AREA SELECTED." S BCHQ=0 Q

 S BCHAREA=+Y

COMM ;get communities and set in ^XTMP

 S BCHIEN=0 F  S BCHIEN=$O(^AUTTCOM(BCHIEN)) Q:BCHIEN'=+BCHIEN  D

 .  Q:$P(^AUTTCOM(BCHIEN,0),U,6)'=BCHAREA

 .  S C=C+1

 .  S ^XTMP("BCH COMMUNITIES",$J,C)=""""_$P(^AUTTCOM(BCHIEN,0),U,8)_""""_","_""""_$P(^AUTTCOM(BCHIEN,0),U)_""""

 .  Q

WRITEF ;EP - write out flat file

 I '$D(^XTMP("BCH COMMUNITIES")) W !!,"NO COMMUNITIES SELECTED." G XIT

 W !,"You have selected ",C," communites to be downloaded.  Here they are: " H 2 S X=0 F  S X=$O(^XTMP("BCH COMMUNITIES",$J,X)) Q:X'=+X  W !,^XTMP("BCH COMMUNITIES",$J,X)

W !

 S DIR(0)="Y",DIR("A")="Do you wish to continue",DIR("B")="Y" K DA D ^DIR K DIR

 I $D(DIRUT)!('Y) W !!,"BYE",! G XIT

 S XBGL="TMP("_"""BCH COMMUNITIES"""_","_$J_","

 S XBMED="F",XBFN="communit.imp",XBTLE="SAVE OF COMMUNITIES"

 S XBF=0,XBQ="N",XBFLT=1,XBE=$J

 D ^XBGSAVE

XIT ;

 K ^XTMP("BCH COMMUNITIES",$J)

 K BCHQ,C,X

BCHDCOMM  ; IHS/CMI/LAB - COMMUNITY DOWNLOAD ROUTINE ;

 +1       ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27

 +2       ;

 +3       ;Generates COMMUNITY file for uploading onto the remote

 +4       ;computer systems.

 +5       ;

EP        ;

 +1        IF $DATA(IOF)

               WRITE @IOF

 +2        WRITE !!,"This utility routine is used to download, by Area, all communities in the",!,"COMMUNITY file to the remote computer."

 +3        WRITE !!,"You will be asked to enter your Area.  A unix file will be created",!,"called communit.imp.  It must be then put in the C:\CHR directory on the ",!,"remote and uploaded into that machine.",!!

 +4       ;

 +5        SET C=0

 +6        KILL ^XTMP("BCH COMMUNITIES",$JOB)

 +7        SET ^XTMP("BCH COMMUNITIES",0)=$$FMADD^XLFDT(DT,14)_U_DT_"CHR DOWNLOAD"

 +8        DO AREA

 +9        IF 'BCHQ

               QUIT

 +10       DO COMM

 +11       DO WRITEF

 +12       DO XIT

 +13       QUIT

 +14      ;

 +15      ;---------------------------------------------

AREA      ;select desired area

 +1        SET BCHQ=1

 +2        SET DIC="^AUTTAREA("

           SET DIC(0)="AEMQ"

           DO ^DIC

 +3        IF Y=-1

               IF '$DATA(^XTMP("BCH COMMUNITIES"))

                   WRITE !!,"NO AREA SELECTED."

               SET BCHQ=0

               QUIT

 +4        SET BCHAREA=+Y

 +5        QUIT

COMM      ;get communities and set in ^XTMP

 +1        SET BCHIEN=0

FOR

               SET BCHIEN=$ORDER(^AUTTCOM(BCHIEN))

               IF BCHIEN'=+BCHIEN

                   QUIT

               Begin DoDot:1

 +2                IF $PIECE(^AUTTCOM(BCHIEN,0),U,6)'=BCHAREA

                       QUIT

 +3                SET C=C+1

 +4                SET ^XTMP("BCH COMMUNITIES",$JOB,C)=""""_$PIECE(^AUTTCOM(BCHIEN,0),U,8)_""""_","_""""_$PIECE(^AUTTCOM(BCHIEN,0),U)_""""

 +5                QUIT

               End DoDot:1

 +6        QUIT

 +7       ;

WRITEF    ;EP - write out flat file

 +1        IF '$DATA(^XTMP("BCH COMMUNITIES"))

               WRITE !!,"NO COMMUNITIES SELECTED."

               GOTO XIT

 +2        WRITE !,"You have selected ",C," communites to be downloaded.  Here they are: "

           HANG 2

           SET X=0

FOR

               SET X=$ORDER(^XTMP("BCH COMMUNITIES",$JOB,X))

               IF X'=+X

                   QUIT

               WRITE !,^XTMP("BCH COMMUNITIES",$JOB,X)

 +3        WRITE !

 +4        SET DIR(0)="Y"

           SET DIR("A")="Do you wish to continue"

           SET DIR("B")="Y"

           KILL DA

           DO ^DIR

           KILL DIR

 +5        IF $DATA(DIRUT)!('Y)

               WRITE !!,"BYE",!

               GOTO XIT

 +6        SET XBGL="TMP("_"""BCH COMMUNITIES"""_","_$JOB_","

 +7        SET XBMED="F"

           SET XBFN="communit.imp"

           SET XBTLE="SAVE OF COMMUNITIES"

 +8        SET XBF=0

           SET XBQ="N"

           SET XBFLT=1

           SET XBE=$JOB

 +9        DO ^XBGSAVE

 +10       QUIT

XIT       ;

 +1        KILL ^XTMP("BCH COMMUNITIES",$JOB)

 +2        KILL BCHQ,C,X

 +3        QUIT

BCHDCOMM.m