ACGSEXPY ;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
;;modifed 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)
S ACGFY=Y,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",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,^%ZISC
;S %FN=$P(%FN,"asc")_"spp"_$P(%FN,"asc",2)
;D OPEN,SSP:POP=0,^%ZISC
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"")" 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"),^TMP("ACG")
S (ACGCNT,ACGRDA,ACGI)=0
F ACGI=1:1 S ACGRDA=$O(^ACGS("T",1,ACGRDA)) Q:'ACGRDA D
.D ^ACGSFLDS
.S ACG2=$P(ACGDT,U,2)
.Q:ACG2=""
.I $D(^TMP($J,"ACG",ACG2)) S ^TMP($J,"ACGERR",ACGRDA,"D")="" Q
.I $L(ACGY)'=600 S ^TMP($J,"ACGERR",ACGRDA)="" Q
.W ACGY
.S ACGCNT=ACGCNT+1,^TMP($J,"ACG",ACG2)=""
D ^%ZISC
K ^TMP("ACG")
S ACGI=ACGI-1
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 U IO
S (ACGRDA,ACGCNT,ACGI)=0
F ACGI=1:1 S ACGRDA=$O(^ACGS("SPP",1,ACGRDA)) Q:'ACGRDA I $P(^ACGS($P(^ACGS(ACGRDA,0),U,3),"IHS"),U,23)=1 S ACGI=ACGI+1 D ^ACGSSPFD I $L(ACGY)=200 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)!(Y<1) K ACGQUIT Q
S:Y>0 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
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
S ACGPARA=^ACGPARA(1,0),X1=$P(ACGPARA,U,7),X2=-180
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
ACGSEXPY ;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 ;;modifed 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 SET ACGFY=Y
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",1:"phs"),1:"ASC")
+6 WRITE !!,"CIS data will now be filed to file '"_%FN_"'"
+7 SET DIR(0)="YO"
SET DIR("A")="Proceed with filing"
SET DIR("B")="NO"
+8 DO DIR^ACGSDIC
+9 IF $DATA(ACGQUIT)!(Y'=1)
SET ACGQUIT=1
QUIT
+10 KILL ^ACGS("T",1),^ACGS("SPP",1)
+11 IF ACG4=236
DO FY^ACGSUP
+12 WRITE !!,"The data export process will now take place. It takes 30-45 minutes.",!,"Please do not interrupt."
+13 DO HFS
DO ^%ZISC
+14 ;S %FN=$P(%FN,"asc")_"spp"_$P(%FN,"asc",2)
+15 ;D OPEN,SSP:POP=0,^%ZISC
+16 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"")"
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"),^TMP("ACG")
+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 DO ^ACGSFLDS
+5 SET ACG2=$PIECE(ACGDT,U,2)
+6 IF ACG2=""
QUIT
+7 IF $DATA(^TMP($JOB,"ACG",ACG2))
SET ^TMP($JOB,"ACGERR",ACGRDA,"D")=""
QUIT
+8 IF $LENGTH(ACGY)'=600
SET ^TMP($JOB,"ACGERR",ACGRDA)=""
QUIT
+9 WRITE ACGY
+10 SET ACGCNT=ACGCNT+1
SET ^TMP($JOB,"ACG",ACG2)=""
End DoDot:1
+11 DO ^%ZISC
+12 KILL ^TMP("ACG")
+13 SET ACGI=ACGI-1
+14 WRITE !!?5,ACGI,?15,"RECORDS EVALUATED",!?5,ACGCNT,?15,"RECORDS PROCESSED"
+15 IF ACGI'=ACGCNT
WRITE !!,*7,*7,?5,ACGI-ACGCNT,?15,"RECORDS NOT PROPERLY PROCESSED.",!?15,"CHECK WITH YOUR SYSTEM OPERATOR."
+16 QUIT
SSP USE IO
+1 SET (ACGRDA,ACGCNT,ACGI)=0
+2 FOR ACGI=1:1
SET ACGRDA=$ORDER(^ACGS("SPP",1,ACGRDA))
IF 'ACGRDA
QUIT
IF $PIECE(^ACGS($PIECE(^ACGS(ACGRDA,0),U,3),"IHS"),U,23)=1
SET ACGI=ACGI+1
DO ^ACGSSPFD
IF $LENGTH(ACGY)=200
WRITE ACGY
SET ACGCNT=ACGCNT+1
+3 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 IF $DATA(ACGQUIT)!(Y<1)
KILL ACGQUIT
QUIT
+7 IF Y>0
SET ACGFY=Y
+8 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
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 SET ACGPARA=^ACGPARA(1,0)
SET X1=$PIECE(ACGPARA,U,7)
SET X2=-180
+2 DO C^%DTC
+3 SET ACGDATE=X-1
+4 DO DCON
+5 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")
+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
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
