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
