ACGSEXPX.m

ACGSEXPX ;IHS/OIRM/DSD/THL,AEF - EXPORT CONTROLLER - CONT'D; [ 03/27/2000   2:22 PM ]

 ;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000

 ;;EXPORT CONTROLLER - CONT'D

EN D ^XBKVAR

 S:'DUZ(2) DUZ(2)=$O(^VA(200,.5,2,0))

 W !!,"Select PROCUREMENT OFFICE for data export"

 D SITE^ACGSPARA

 Q:'$D(^ACGPARA(ACGPODA,0))  S ACGPARA=^(0),ACG4=$P(ACGPARA,U,3)

 I ACG4<200 D DX^ACGSEXP Q

 S ACGX="rm /usr/spool/uucppublic/acg"_ACG4_".asc*",ACGX=$$JOBWAIT^%HOSTCMD(ACGX)

 S ACGX="rm /usr2/acg"_ACG4_".asc*",ACGX=$$JOBWAIT^%HOSTCMD(ACGX)

 I ACG4=236 D ^ACGSEXP Q

 D DX^ACGSEXP

 S ACGX="sendto dpssyg /usr/spool/uucppublic/acg"_ACG4_".asc",ACGX=$$JOBWAIT^%HOSTCMD(ACGX)

 S DR="3////1;4////"_DT,DIE="^ACGPARA(",DA=1

 D DIE^ACGSDIC

EXIT K ACGT1,ACGRDA,ACGSIGN,ACGY,ACGFY,%DEV,%FN,%X,%Y

 Q

EXPORT S AUDT=DT,AUGL="ACGEXP",AUGL="ACGS",AUIO=51,AUMED="F",AUTLE="CIS MONTHLY DATA EXPORT",(AUFN,%FN)=$S($P(ACGPARA,U,2)=1:"acg",1:"A:ACG")_ACG4_".asc"

 I ACG4=236 D HQ Q

 D ^XBGSAVE

 S DR="3////1;4////"_DT

 S DIE="^ACGPARA(",DA=1 D ^DIE K DIE,DA,DR

 Q

HQ S ACGT1=$P($H,",",2)

HFS1 S %ZIS("IOPAR")=%FN,IOP=$S(ACG4>200:"HOST FILE SERVER #4",1:51)

 D ^%ZIS

 K IOP

 I POP>0 S DR="3////2",DIE="^ACGPARA(",DA=1 D ^DIE K DIE,DA,DR Q

 U IO

 S (ACGCNT,ACGRDA)=0

 ;F  S ACGRDA=$O(^ACGS(ACGRDA)) Q:'ACGRDA  I +^ACGS(ACGRDA,"DT")'=14,+^("DT")'=16,$P(^ACGS($P(^(0),U,3),"IHS"),U,23)=1 D ^ACGSFLDS I $L(ACGY)=600 S ACGY=ACGY_"                                                  " W ACGY

 F  S ACGRDA=$O(^ACGS(ACGRDA)) Q:'ACGRDA  I +^ACGS(ACGRDA,"DT")'=14,+^("DT")'=16,$P(^ACGS($P(^(0),U,3),"IHS"),U,23)=1 D ^ACGSDCIS I $L(ACGY)=600  W ACGY

 D ^%ZISC

 S DR="3////1;4////"_DT,DIE="^ACGPARA(",DA=1

 D ^DIE

 K DIE,DA,DR

 Q

ACGSEXPX  ;IHS/OIRM/DSD/THL,AEF - EXPORT CONTROLLER - CONT'D; [ 03/27/2000   2:22 PM ]

 +1       ;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000

 +2       ;;EXPORT CONTROLLER - CONT'D

EN         DO ^XBKVAR

 +1        IF 'DUZ(2)

               SET DUZ(2)=$ORDER(^VA(200,.5,2,0))

 +2        WRITE !!,"Select PROCUREMENT OFFICE for data export"

 +3        DO SITE^ACGSPARA

 +4        IF '$DATA(^ACGPARA(ACGPODA,0))

               QUIT 

           SET ACGPARA=^(0)

           SET ACG4=$PIECE(ACGPARA,U,3)

 +5        IF ACG4<200

               DO DX^ACGSEXP

               QUIT 

 +6        SET ACGX="rm /usr/spool/uucppublic/acg"_ACG4_".asc*"

           SET ACGX=$$JOBWAIT^%HOSTCMD(ACGX)

 +7        SET ACGX="rm /usr2/acg"_ACG4_".asc*"

           SET ACGX=$$JOBWAIT^%HOSTCMD(ACGX)

 +8        IF ACG4=236

               DO ^ACGSEXP

               QUIT 

 +9        DO DX^ACGSEXP

 +10       SET ACGX="sendto dpssyg /usr/spool/uucppublic/acg"_ACG4_".asc"

           SET ACGX=$$JOBWAIT^%HOSTCMD(ACGX)

 +11       SET DR="3////1;4////"_DT

           SET DIE="^ACGPARA("

           SET DA=1

 +12       DO DIE^ACGSDIC

EXIT       KILL ACGT1,ACGRDA,ACGSIGN,ACGY,ACGFY,%DEV,%FN,%X,%Y

 +1        QUIT 

EXPORT     SET AUDT=DT

           SET AUGL="ACGEXP"

           SET AUGL="ACGS"

           SET AUIO=51

           SET AUMED="F"

           SET AUTLE="CIS MONTHLY DATA EXPORT"

           SET (AUFN,%FN)=$SELECT($PIECE(ACGPARA,U,2)=1:"acg",1:"A:ACG")_ACG4_".asc"

 +1        IF ACG4=236

               DO HQ

               QUIT 

 +2        DO ^XBGSAVE

 +3        SET DR="3////1;4////"_DT

 +4        SET DIE="^ACGPARA("

           SET DA=1

           DO ^DIE

           KILL DIE,DA,DR

 +5        QUIT 

HQ         SET ACGT1=$PIECE($HOROLOG,",",2)

HFS1       SET %ZIS("IOPAR")=%FN

           SET IOP=$SELECT(ACG4>200:"HOST FILE SERVER #4",1:51)

 +1        DO ^%ZIS

 +2        KILL IOP

 +3        IF POP>0

               SET DR="3////2"

               SET DIE="^ACGPARA("

               SET DA=1

               DO ^DIE

               KILL DIE,DA,DR

               QUIT 

 +4        USE IO

 +5        SET (ACGCNT,ACGRDA)=0

 +6       ;F  S ACGRDA=$O(^ACGS(ACGRDA)) Q:'ACGRDA  I +^ACGS(ACGRDA,"DT")'=14,+^("DT")'=16,$P(^ACGS($P(^(0),U,3),"IHS"),U,23)=1 D ^ACGSFLDS I $L(ACGY)=600 S ACGY=ACGY_"                                                  " W ACGY

 +7        FOR 

               SET ACGRDA=$ORDER(^ACGS(ACGRDA))

               IF 'ACGRDA

                   QUIT 

               IF +^ACGS(ACGRDA,"DT")'=14

                   IF +^("DT")'=16

                       IF $PIECE(^ACGS($PIECE(^(0),U,3),"IHS"),U,23)=1

                           DO ^ACGSDCIS

                           IF $LENGTH(ACGY)=600

                               WRITE ACGY

 +8        DO ^%ZISC

 +9        SET DR="3////1;4////"_DT

           SET DIE="^ACGPARA("

           SET DA=1

 +10       DO ^DIE

 +11       KILL DIE,DA,DR

 +12       QUIT