ACGSEXP.m

ACGSEXP ;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

 ;;modified for y2k;mlp

EN D EXPORT

EXIT K ACGT1,ACGRDA,ACGSIGN,ACGY,ACGFY,%DEV,%FN,%CMT,%GN,%QUIT,%SIZE,%TAP,%TAPV

 Q

EXPORT D ^XBKVAR,HEAD^ACGSMENU

 W !!?30,"DATA EXPORT UTILITY"

 W !

 D FY

 Q:$D(ACGQUIT)

 D DCIS

 Q:$D(ACGQUIT)

 S ACG4=$P(ACGPARA,U,3),%FN=$S(ACG4=236:"/usr2/acg",ACG4=102:"ACG",1:"A:ACG")_ACG4_"."_$S($P(ACGPARA,U,2)=1:$S(ACG4'=236:"asc",$G(ACGFORMT)=2:"dcis",1:"phs"),1:"ASC")

 W !!,"CIS data will now be filed to file '"_%FN_"'"

 S DIR(0)="YO",DIR("A")="Proceed with filing",DIR("B")="NO"

 D DIR^ACGSDIC

 I $D(ACGQUIT)!(Y'=1) S ACGQUIT=1 Q

 K ^ACGS("T",1),^ACGS("SPP",1)

 I ACG4=236 D FY^ACGSUP

 W !!,"The data export process will now take place.  It takes 30-45 minutes.",!,"Please do not interrupt."

 D HFS

 ;S %FN=$P(%FN,"phs")_"spp"

 ;D OPEN,SSP:POP=0,^%ZISC,COUNT

 Q

HFS D OPEN

 Q:POP>0

 I ACG4=236 D HQ Q

 I ACG4'=236 D AREAS

 Q

OPEN ;OPEN HOST FILE

 F ACGI=1:1:4 S (IOP,ION)="HOST FILE SERVER #"_ACGI,%ZIS("IOPAR")="("""_%FN_""":""W"")" U 0 W !,IOP D ^%ZIS Q:'POP

 I POP W *7,*7,!!,"Waiting for HOST FILE SERVER" H 2 G OPEN

 K IOP

 Q

AREAS U IO

 S %DEV=IO,(%TAP,%TAPV)=0,%GN="ACGS",^TMP($J,"ACGS")="",%CMT="",%SIZE=1024*1000,%QUIT=0

 D START^%GS

 Q

HQ U IO

 K ^TMP("ACGERR",DT),^TMP("ACG",DT)

 S (ACGCNT,ACGRDA,ACGI)=0

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

 .D:$G(ACGFORMT)=1 ^ACGSFLDS

 .D:$G(ACGFORMT)=2 ^ACGSDCIS

 .S ACG2=$P(ACGDT,U,2)

 .Q:ACG2=""

 .I $D(^TMP($J,"ACG",DT,ACG2)) S ^TMP($J,"ACGERR",DT,ACGRDA,"DUP")=ACG2 Q

 .I $G(ACGFORMT)=2,$P(ACGDT1,U,5)<500.0001 S ACGCNT=ACGCNT+1 Q

 .I $L(ACGY)'=600 S ^TMP($J,"ACGERR",DT,ACGRDA,"DATA")="" Q

 .W ACGY_$S($G(ACGFORMT)=1:"                                                  ",1:""),!

 .S ACGCNT=ACGCNT+1,^TMP("ACG",DT,ACG2)=""

 D ^%ZISC

 S ACGI=ACGI-1

COUNT W !!?5,ACGI,?15,"RECORDS EVALUATED",!?5,ACGCNT,?15,"RECORDS PROCESSED"

 I ACGI'=ACGCNT W !!,*7,*7,?5,ACGI-ACGCNT,?15,"RECORDS NOT PROPERLY PROCESSED.",!?15,"CHECK WITH YOUR SYSTEM OPERATOR."

 Q

SSP I '$D(ZTQUEUED) U 0 W !!,"SMALL PURCHASE EXPORT WILL NOW TAKE PLACE.",!

 U IO

 K ^TMP("ACGSPPERR")

 S (ACGRDA,ACGCNT,ACGI)=0

 F  S ACGRDA=$O(^ACGS("SPP",1,ACGRDA)) Q:'ACGRDA  I $P(^ACGS($P(^ACGS(ACGRDA,0),U,3),"IHS"),U,23)=1 D

 .S ACGI=ACGI+1

 .D ^ACGSSPFD

 .I $L(ACGY)'=300 S ^TMP($J,"ACGSPPERR",ACGRDA)="" Q

 .I $L(ACGY)=300 W ACGY S ACGCNT=ACGCNT+1

 Q

FY ;XEP;TO SET FISCAL YEAR

 ;;THIS POINT IS CALLED BY ARMS DURING INTERFACE BETWEEN ARMS AND CIS

 ;S ACGFY=$E(DT,4,5),ACGFY=$S(ACGFY<10:$E(DT,2,3),1:$E(DT,2,3)+1),DIR(0)="FOA^2:2",DIR("A")="Fiscal year: ",DIR("B")=ACGFY

 S ACGFY=$E(DT,4,5),ACGFY=$S(ACGFY<10:($E(DT,1,3)+1700),1:($E(DT,1,3)+1700)+1),DIR(0)="FOA^4:4",DIR("A")="Fiscal year: ",DIR("B")=ACGFY ;y2k;mlp

 W !

 D DIR^ACGSDIC

 ;I $D(ACGQUIT)!($G(Y)'?2N) S ACGQUIT="" Q

 I $D(ACGQUIT)!($G(Y)'?4N) S ACGQUIT="" Q  ;y2k;mlp

 S ACGFY=Y

 Q

FY1 ;EP;TO SET FISCAL YEAR

 ;S ACGFY=$E(DT,4,5),ACGFY=$S(ACGFY<10:$E(DT,2,3),1:$E(DT,2,3)+1)

 S ACGFY=$E(DT,4,5),ACGFY=$S(ACGFY<10:($E(DT,1,3)+1700),1:($E(DT,1,3)+1700)+1) ;y2k;mlp

 Q

DCIS ;SELECT FORMAT FOR DATA EXPORT

 S DIR(0)="SO^1:PHS-CIS Format;2:DCIS Format",DIR("A")="Which format",DIR("B")="DCIS Format"

 W !

 D DIR^ACGSDIC

 I 12'[$G(Y) S ACGQUIT="" Q

 S ACGFORMT=Y

 Q

DATE 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=$G(@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,!

 Q

DX ;EP;TO EXPORT RECORDS BY DATE LAST EDITED

 W !

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

 D C^%DTC

 S ACGDATE=X-1

 D DCON

 S ACG4=$P(ACGPARA,U,3),ACG2=$P(ACGPARA,U,2),%FN=$S(ACG2=1:"/usr/spool/uucppublic/acg",ACG4=102:"ACG",1:"A:ACG")_ACG4_"."_$S(ACG2=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

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

ACGSEXP   ;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

 +4       ;;modified for y2k;mlp

EN         DO EXPORT

EXIT       KILL ACGT1,ACGRDA,ACGSIGN,ACGY,ACGFY,%DEV,%FN,%CMT,%GN,%QUIT,%SIZE,%TAP,%TAPV

 +1        QUIT 

EXPORT     DO ^XBKVAR

           DO HEAD^ACGSMENU

 +1        WRITE !!?30,"DATA EXPORT UTILITY"

 +2        WRITE !

 +3        DO FY

 +4        IF $DATA(ACGQUIT)

               QUIT 

 +5        DO DCIS

 +6        IF $DATA(ACGQUIT)

               QUIT 

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

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

 +8        WRITE !!,"CIS data will now be filed to file '"_%FN_"'"

 +9        SET DIR(0)="YO"

           SET DIR("A")="Proceed with filing"

           SET DIR("B")="NO"

 +10       DO DIR^ACGSDIC

 +11       IF $DATA(ACGQUIT)!(Y'=1)

               SET ACGQUIT=1

               QUIT 

 +12       KILL ^ACGS("T",1),^ACGS("SPP",1)

 +13       IF ACG4=236

               DO FY^ACGSUP

 +14       WRITE !!,"The data export process will now take place.  It takes 30-45 minutes.",!,"Please do not interrupt."

 +15       DO HFS

 +16      ;S %FN=$P(%FN,"phs")_"spp"

 +17      ;D OPEN,SSP:POP=0,^%ZISC,COUNT

 +18       QUIT 

HFS        DO OPEN

 +1        IF POP>0

               QUIT 

 +2        IF ACG4=236

               DO HQ

               QUIT 

 +3        IF ACG4'=236

               DO AREAS

 +4        QUIT 

OPEN      ;OPEN HOST FILE

 +1        FOR ACGI=1:1:4

               SET (IOP,ION)="HOST FILE SERVER #"_ACGI

               SET %ZIS("IOPAR")="("""_%FN_""":""W"")"

               USE 0

               WRITE !,IOP

               DO ^%ZIS

               IF 'POP

                   QUIT 

 +2        IF POP

               WRITE *7,*7,!!,"Waiting for HOST FILE SERVER"

               HANG 2

               GOTO OPEN

 +3        KILL IOP

 +4        QUIT 

AREAS      USE IO

 +1        SET %DEV=IO

           SET (%TAP,%TAPV)=0

           SET %GN="ACGS"

           SET ^TMP($JOB,"ACGS")=""

           SET %CMT=""

           SET %SIZE=1024*1000

           SET %QUIT=0

 +2        DO START^%GS

 +3        QUIT 

HQ         USE IO

 +1        KILL ^TMP("ACGERR",DT),^TMP("ACG",DT)

 +2        SET (ACGCNT,ACGRDA,ACGI)=0

 +3        FOR ACGI=1:1

               SET ACGRDA=$ORDER(^ACGS("T",1,ACGRDA))

               IF 'ACGRDA

                   QUIT 

               Begin DoDot:1

 +4                IF $GET(ACGFORMT)=1

                       DO ^ACGSFLDS

 +5                IF $GET(ACGFORMT)=2

                       DO ^ACGSDCIS

 +6                SET ACG2=$PIECE(ACGDT,U,2)

 +7                IF ACG2=""

                       QUIT 

 +8                IF $DATA(^TMP($JOB,"ACG",DT,ACG2))

                       SET ^TMP($JOB,"ACGERR",DT,ACGRDA,"DUP")=ACG2

                       QUIT 

 +9                IF $GET(ACGFORMT)=2

                       IF $PIECE(ACGDT1,U,5)<500.0001

                           SET ACGCNT=ACGCNT+1

                           QUIT 

 +10               IF $LENGTH(ACGY)'=600

                       SET ^TMP($JOB,"ACGERR",DT,ACGRDA,"DATA")=""

                       QUIT 

 +11               WRITE ACGY_$SELECT($GET(ACGFORMT)=1:"                                                  ",1:""),!

 +12               SET ACGCNT=ACGCNT+1

                   SET ^TMP("ACG",DT,ACG2)=""

               End DoDot:1

 +13       DO ^%ZISC

 +14       SET ACGI=ACGI-1

COUNT      WRITE !!?5,ACGI,?15,"RECORDS EVALUATED",!?5,ACGCNT,?15,"RECORDS PROCESSED"

 +1        IF ACGI'=ACGCNT

               WRITE !!,*7,*7,?5,ACGI-ACGCNT,?15,"RECORDS NOT PROPERLY PROCESSED.",!?15,"CHECK WITH YOUR SYSTEM OPERATOR."

 +2        QUIT 

SSP        IF '$DATA(ZTQUEUED)

               USE 0

               WRITE !!,"SMALL PURCHASE EXPORT WILL NOW TAKE PLACE.",!

 +1        USE IO

 +2        KILL ^TMP("ACGSPPERR")

 +3        SET (ACGRDA,ACGCNT,ACGI)=0

 +4        FOR 

               SET ACGRDA=$ORDER(^ACGS("SPP",1,ACGRDA))

               IF 'ACGRDA

                   QUIT 

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

                   Begin DoDot:1

 +5                    SET ACGI=ACGI+1

 +6                    DO ^ACGSSPFD

 +7                    IF $LENGTH(ACGY)'=300

                           SET ^TMP($JOB,"ACGSPPERR",ACGRDA)=""

                           QUIT 

 +8                    IF $LENGTH(ACGY)=300

                           WRITE ACGY

                           SET ACGCNT=ACGCNT+1

                   End DoDot:1

 +9        QUIT 

FY        ;XEP;TO SET FISCAL YEAR

 +1       ;;THIS POINT IS CALLED BY ARMS DURING INTERFACE BETWEEN ARMS AND CIS

 +2       ;S ACGFY=$E(DT,4,5),ACGFY=$S(ACGFY<10:$E(DT,2,3),1:$E(DT,2,3)+1),DIR(0)="FOA^2:2",DIR("A")="Fiscal year: ",DIR("B")=ACGFY

 +3       ;y2k;mlp

           SET ACGFY=$EXTRACT(DT,4,5)

           SET ACGFY=$SELECT(ACGFY<10:($EXTRACT(DT,1,3)+1700),1:($EXTRACT(DT,1,3)+1700)+1)

           SET DIR(0)="FOA^4:4"

           SET DIR("A")="Fiscal year: "

           SET DIR("B")=ACGFY

 +4        WRITE !

 +5        DO DIR^ACGSDIC

 +6       ;I $D(ACGQUIT)!($G(Y)'?2N) S ACGQUIT="" Q

 +7       ;y2k;mlp

           IF $DATA(ACGQUIT)!($GET(Y)'?4N)

               SET ACGQUIT=""

               QUIT 

 +8        SET ACGFY=Y

 +9        QUIT 

FY1       ;EP;TO SET FISCAL YEAR

 +1       ;S ACGFY=$E(DT,4,5),ACGFY=$S(ACGFY<10:$E(DT,2,3),1:$E(DT,2,3)+1)

 +2       ;y2k;mlp

           SET ACGFY=$EXTRACT(DT,4,5)

           SET ACGFY=$SELECT(ACGFY<10:($EXTRACT(DT,1,3)+1700),1:($EXTRACT(DT,1,3)+1700)+1)

 +3        QUIT 

DCIS      ;SELECT FORMAT FOR DATA EXPORT

 +1        SET DIR(0)="SO^1:PHS-CIS Format;2:DCIS Format"

           SET DIR("A")="Which format"

           SET DIR("B")="DCIS Format"

 +2        WRITE !

 +3        DO DIR^ACGSDIC

 +4        IF 12'[$GET(Y)

               SET ACGQUIT=""

               QUIT 

 +5        SET ACGFORMT=Y

 +6        QUIT 

DATE       USE IO

 +1        SET ACGCNT=0

           SET ACGD=ACGDATE

 +2        FOR 

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

               IF 'ACGD

                   QUIT 

               Begin DoDot:1

 +3                SET ACGRDA=0

 +4                FOR ACGI=1:1

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

                       IF 'ACGRDA

                           QUIT 

                       Begin DoDot:2

 +5                        FOR X=0,10

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

                               SET Z=$GET(@Y)

                               WRITE Y,!,Z,!

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

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

                               SET Z=$GET(@Y)

                               WRITE Y,!,Z,!

                       End DoDot:2

               End DoDot:1

 +7        QUIT 

DX        ;EP;TO EXPORT RECORDS BY DATE LAST EDITED

 +1        WRITE !

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

           SET X1=$PIECE(ACGPARA,U,7)

           SET X2=-90

 +3        DO C^%DTC

 +4        SET ACGDATE=X-1

 +5        DO DCON

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

           SET ACG2=$PIECE(ACGPARA,U,2)

           SET %FN=$SELECT(ACG2=1:"/usr/spool/uucppublic/acg",ACG4=102:"ACG",1:"A:ACG")_ACG4_"."_$SELECT(ACG2=1:$SELECT(ACG4'=236:"asc",1:"phs"),1:"ASC")

 +7        DO OPEN

 +8        IF POP

               DO CLOSE

               QUIT 

 +9        USE IO

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

 +11       DO DATE

           DO DXC

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