ACGSDX.m

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

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

 ;;UTILITY WHICH CREATES THE EXPORT GLOBAL AND TRANSMITS IT TO THE

 ;;ALBUQUERQUE DATA CENTER - FOR EDITED ACTIONS ONLY

DX ;EP;TO EXPORT RECORDS BY DATE LAST EDITED

 S X1=$P(^ACGPARA(ACGPODA,0),U,7),X2=-30

 D C^%DTC

 S ACGDATE=X

 D DCON

 S ACGPARA=^ACGPARA(ACGPODA,0),ACG4=$P(ACGPARA,U,3),%FN=$S($P(ACGPARA,U,2)=1:"acg",ACG4=102:"B:ACG",1:"ACG")_ACG4_"."_$S($P(ACGPARA,U,2)=1:$S(ACG4'=236:"asc",1:"phs"),1:"ASC")

 D OPEN

 I POP D CLOSE Q

 U IO

 W ACGX,!,"MONTHLY EXPORT FOR CONTRACT OFFICE ",ACG4,!

 D DATE,DXC

 Q

OPEN ;OPEN HOST FILE

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

 D ^%ZIS

 K IOP

 I POP>0 W *7,*7,!!,"HOST FILE SERVER not available.  Export terminated.  Please retry later." D HOLD^ACGSMENU

 Q

DATE ;WRITE GLOBAL DATA TO HOST FILE

 U IO

 S ACGCNT=0,ACGD=ACGDATE

 F  S ACGD=$O(^ACGS("Q",ACGD)) Q:'ACGD  D

 .S ACGRDA=0

 .F ACGI=1:1 S ACGRDA=$O(^ACGS("Q",ACGD,ACGRDA)) Q:'ACGRDA  D

 ..F X=0,10 S Y="^ACGS("_ACGRDA_","_X_")",Z=@Y W Y,!,Z,!

 ..F X="DT","DT1","DT2","DT3","IC","IHS","IHS1","SP" S Y="^ACGS("_ACGRDA_","""_X_""")",Z=$G(@Y) W Y,!,Z,!

 ..S Y="^ACGS(""ACGEXP"","_ACGRDA_")",Z=""

 ..W Y,!,Z,!

 Q

DXC ;CLOSE EXPORT

 W "*",!,"*",!,"**",!,"**",!

CLOSE D ^%ZISC

 Q

DCON ;CONVERT DATE FOR GLOBAL SAVE

 D NOW^%DTC

 S Y=%

 X ^DD("DD")

 S X=$P(Y,"@"),Y=$P(Y,"@",2),ACGX=$P($P(X,",")," ",2)_"-"_$P(X," ")_"-"_$E($P(X,",",2),3,4),ACGY=" "_$S($P(Y,":")<13:+$P(Y,":"),1:$P(Y,":")-12)_":"_$P(Y,":",2)_" "_$S($P(Y,":")<13:"AM",1:"PM"),ACGX=ACGY_"  "_ACGX

 Q

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

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

 +2       ;;UTILITY WHICH CREATES THE EXPORT GLOBAL AND TRANSMITS IT TO THE

 +3       ;;ALBUQUERQUE DATA CENTER - FOR EDITED ACTIONS ONLY

DX        ;EP;TO EXPORT RECORDS BY DATE LAST EDITED

 +1        SET X1=$PIECE(^ACGPARA(ACGPODA,0),U,7)

           SET X2=-30

 +2        DO C^%DTC

 +3        SET ACGDATE=X

 +4        DO DCON

 +5        SET ACGPARA=^ACGPARA(ACGPODA,0)

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

           SET %FN=$SELECT($PIECE(ACGPARA,U,2)=1:"acg",ACG4=102:"B:ACG",1:"ACG")_ACG4_"."_$SELECT($PIECE(ACGPARA,U,2)=1:$SELECT(ACG4'=236:"asc",1:"phs"),1:"ASC")

 +6        DO OPEN

 +7        IF POP

               DO CLOSE

               QUIT 

 +8        USE IO

 +9        WRITE ACGX,!,"MONTHLY EXPORT FOR CONTRACT OFFICE ",ACG4,!

 +10       DO DATE

           DO DXC

 +11       QUIT 

OPEN      ;OPEN HOST FILE

 +1        SET %ZIS("IOPAR")=%FN

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

 +2        DO ^%ZIS

 +3        KILL IOP

 +4        IF POP>0

               WRITE *7,*7,!!,"HOST FILE SERVER not available.  Export terminated.  Please retry later."

               DO HOLD^ACGSMENU

 +5        QUIT 

DATE      ;WRITE GLOBAL DATA TO HOST FILE

 +1        USE IO

 +2        SET ACGCNT=0

           SET ACGD=ACGDATE

 +3        FOR 

               SET ACGD=$ORDER(^ACGS("Q",ACGD))

               IF 'ACGD

                   QUIT 

               Begin DoDot:1

 +4                SET ACGRDA=0

 +5                FOR ACGI=1:1

                       SET ACGRDA=$ORDER(^ACGS("Q",ACGD,ACGRDA))

                       IF 'ACGRDA

                           QUIT 

                       Begin DoDot:2

 +6                        FOR X=0,10

                               SET Y="^ACGS("_ACGRDA_","_X_")"

                               SET Z=@Y

                               WRITE Y,!,Z,!

 +7                        FOR X="DT","DT1","DT2","DT3","IC","IHS","IHS1","SP"

                               SET Y="^ACGS("_ACGRDA_","""_X_""")"

                               SET Z=$GET(@Y)

                               WRITE Y,!,Z,!

 +8                        SET Y="^ACGS(""ACGEXP"","_ACGRDA_")"

                           SET Z=""

 +9                        WRITE Y,!,Z,!

                       End DoDot:2

               End DoDot:1

 +10       QUIT 

DXC       ;CLOSE EXPORT

 +1        WRITE "*",!,"*",!,"**",!,"**",!

CLOSE      DO ^%ZISC

 +1        QUIT 

DCON      ;CONVERT DATE FOR GLOBAL SAVE

 +1        DO NOW^%DTC

 +2        SET Y=%

 +3        XECUTE ^DD("DD")

 +4        SET X=$PIECE(Y,"@")

           SET Y=$PIECE(Y,"@",2)

           SET ACGX=$PIECE($PIECE(X,",")," ",2)_"-"_$PIECE(X," ")_"-"_$EXTRACT($PIECE(X,",",2),3,4)

           SET ACGY=" "_$SELECT($PIECE(Y,":")<13:+$PIECE(Y,":"),1:$PIECE(Y,":")-12)_":"_$PIECE(Y,":",2)_" "_$SELECT($PIECE(Y,":")<13:"AM",1:"PM")

           SET ACGX=ACGY_"  "_ACGX

 +5        QUIT