ACHSACOA ; IHS/ITSC/TPF/PMF - AREA CONSOLIDATION (PT 2 OF ACHSACO) ;JUL 10, 2008
;;3.1;CONTRACT HEALTH MGMT SYSTEM;**13,14,18,21**;JUN 11,2001;Build 43
;ACHS*3.1*13 6.14.2007 IHS/OIT/FCJ ADDED UFMS SUB FOR TOTAL RECORDS AND SENDING FILE
;ACHS*3.1*14 10.02.2007 IHS/OIT/FCJ CHG DOLLAR LENGHT IN UFMS BATCH TRAILER RECORD
;
XIT ;EP
U IO(0)
;I $$DIR^XBDIR("E","Press <RETURN> to END") ;ACHS*3.1*21 REQUESTING A RETURN BELOW IN ACHSVAR
I $D(ACHSPTR) S IO=ACHSPTR D ^%ZISC
END ;
K DA,DIC,DIR,I,J,K,W,X,Y,Z
D EN^XBVK("ACHS")
S ACHSISAO=1 D ^ACHSVAR ;ACHS*3.1*21 ADDED TEST FOR AREA VAR
S %=$$DEL^%ZISH("/usr/spool/chsdata/","achs.cons.list")
K ^TMP("ACHSACO",$J)
Q
;
ABEND ;EP
D ^%ZISC
W "File Not Found",!!,"ABNORMAL END OF CHS CONSOLIDATION",!
I $$DIR^XBDIR("E","Press <RETURN> To Continue...")
D END
Q
;
REPORT ;EP
I '(IO(0)=ACHSPTR)!($D(ACHSPPO)) S ACHSIO=ACHSPTR D REPORT^ACHSACO2
S ACHSIO=IO(0)
K ACHSPPO,ACHSPPC
;
D REPORT^ACHSACO2 ;AREA OFFICE CONSOLIDATION REPORT
;
I $D(^ACHSSVR),$O(^ACHSSVR(0)) D
.U IO(0)
.W !!?10,"PRINTING VENDOR SPECIAL REPORTS",!
.D ^ACHSSVRP ;SELECT AND PRINT AO SPECIAL VENDOR REPORT
;
D UFMS ;ACHS*3.1*13 6.14.2007 IHS/OIT/FCJ SET HEADER AND TRAILER RECORDS FOR UFMS
D FILEBLD ;MOVE TO UNDOCUMENTED PARAMETER
D SENDMSG ;SEND MESSAGE TO MAIL GROUP
D XIT
Q
;
FILEBLD ;
I +ACHSZFAC("TOTAL")>0 G FILEBLDA
U IO(0)
W !!,"NO RECORDS CONSOLIDATED FROM FACILITIES ",!
Q
;
FILEBLDA ;
U IO(0)
;
;CHECK UNDOCUMENTED PIECE (PARAMETER)
;ACHS*3.1*21 COMMENTED OUT NEXT LINE WILL NOT SEND TO TAPE, QUIT IF NO ARCHIEVE DIRECTORY DEFINNED
;G:'$L($$AOP^ACHS(2,13)) CHSTAR
D FILEDEL ;ACHS*3.1*21 THIS IS CALLED FR CHSTAR SO MV'D HERE
Q:'$L($$AOP^ACHS(2,13))
;
;UNDOCUMENTED PARAMETER
W !!," moving your facility files to '",$$AOP^ACHS(2,13),"'..."
;
;ACHS*3.1*21 CHANGED $$IM^ACHS TO ACHSPTH AND PTH IS SET FOR 252611
F ACHSI=1:1 Q:'$D(ACHSPLST(ACHSI)) D
.W !,$P(ACHSPLST(ACHSI),U)
.;I $$ASF^ACHS(DUZ(2))=252611 S X=$$MV^%ZISH($$EX^ACHS,$P(ACHSPLST(ACHSI),U),$$AOP^ACHS(2,13),$P(ACHSPLST(ACHSI),U)) ;ACHS*3.1*18
.;E S X=$$MV^%ZISH($$IM^ACHS,$P(ACHSPLST(ACHSI),U),$$AOP^ACHS(2,13),$P(ACHSPLST(ACHSI),U)) ;ACHS*3.1*18
.S X=$$MV^%ZISH(ACHSPTH,$P(ACHSPLST(ACHSI),U),$$AOP^ACHS(2,13),$P(ACHSPLST(ACHSI),U))
;
Q
;
CHSTAR ;ASK OPERATOR ABOUT BACKING UP CHS PROCESSED FILES TO TAPE
U IO(0)
I '$$DIR^XBDIR("Y","Do you want to BACKUP processed CHS Facility Data to TAPE","Y","","","",1) D FILEDEL Q
;
FLCP1 ;
U IO(0)
W !
;
;ARCHIVE TO TAPE ????? mikey questioned whether this works
S ACHSHCMD=("tar -cvft /dev/rct0 `cat /usr/spool/chsdata/achs.bk` ")
;
;IHS/ITSC/PMF 1/12/01 change call of vendor routine to call
;or routine in our namespace
S ACHSRTCD=$$TERMINAL^ACHSHCMD(ACHSHCMD) ;GET RETURN CODE
;
I ACHSRTCD>0 W !!?3,"BACKUP WAS UNSUCCESSFUL - FILES NOT DELETED FROM /usr/spool/uucppublic",! Q
;
;
;ACHS*3.1*21 MODIFIED ENTIRE FILEDEL SECTION TO USE %ZISH AND USED ACHSPTH FOR THE DIRECTORY
FILEDEL ;DELETE FACILITY FILES PROCESSED FROM ACHSPTH
Q ;FILES ARE BEING MOVED TO ARCHIVED NOT COPIED..ACHS*3.1*21
U IO(0)
I '$$DIR^XBDIR("Y","Should CHS Facility Files processed from "_ACHSPTH_" be DELETED","N","","","",1) Q
S L=0,L1=0,L2=0 F S L=$O(ACHSPLST(L)) Q:L'?1N.N D
.S L1=$$DEL^%ZISH(ACHSPTH,ACHSPLST(L))
.I L1>0 S L2=1
I L2 W !,"ALL FILES COULD NOT BE DELETED"
E W !,"FILES DELETED...."
;
Q
;
SENDMSG ;
N XMSUB,XMDUZ,XMTEXT,XMY
S XMB="ACHS AREA BALANCES" ;MAIL GROUP
S XMDUZ="CHS Area Office Consolidation",XMSUB="CHS Facility Account Balances."
S XMTEXT="^TMP(""ACHSACO"",$J,"
D ^XMB,KILL^XM
Q
;ACHS*3.1*13 6.14.2007 IHS/OIT/FCJ
UFMS ;SET BATCH HEADER AND RECORD FOR THE UFMS FILE, SAVE AND SEND FILE;
S X=$E(DT,4,7)_$E(DT,2,3)
;ACHS*3.1*14 10.02.2007 IHS/OIT/FCJ CHG 10 TO 11 IN NEXT LINE
S ^ACHSUFMS("COUNT")="4BATCH"_X_"Z3"_$E(10000+^ACHSUFMS("COUNT"),2,5)_$J("",21)_"J"_$P(^AUTTSITE(1,0),U,2)_$J("",6)_$E(10000000000+^ACHSUFMS(0),2,11)_$J("",78)
S ^ACHSUFMS(0)="1BATCH"_X_"Z3"_$J("",121)
Q
;
ACHSACOA ; IHS/ITSC/TPF/PMF - AREA CONSOLIDATION (PT 2 OF ACHSACO) ;JUL 10, 2008
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**13,14,18,21**;JUN 11,2001;Build 43
+2 ;ACHS*3.1*13 6.14.2007 IHS/OIT/FCJ ADDED UFMS SUB FOR TOTAL RECORDS AND SENDING FILE
+3 ;ACHS*3.1*14 10.02.2007 IHS/OIT/FCJ CHG DOLLAR LENGHT IN UFMS BATCH TRAILER RECORD
+4 ;
XIT ;EP
+1 USE IO(0)
+2 ;I $$DIR^XBDIR("E","Press <RETURN> to END") ;ACHS*3.1*21 REQUESTING A RETURN BELOW IN ACHSVAR
+3 IF $DATA(ACHSPTR)
SET IO=ACHSPTR
DO ^%ZISC
END ;
+1 KILL DA,DIC,DIR,I,J,K,W,X,Y,Z
+2 DO EN^XBVK("ACHS")
+3 ;ACHS*3.1*21 ADDED TEST FOR AREA VAR
SET ACHSISAO=1
DO ^ACHSVAR
+4 SET %=$$DEL^%ZISH("/usr/spool/chsdata/","achs.cons.list")
+5 KILL ^TMP("ACHSACO",$JOB)
+6 QUIT
+7 ;
ABEND ;EP
+1 DO ^%ZISC
+2 WRITE "File Not Found",!!,"ABNORMAL END OF CHS CONSOLIDATION",!
+3 IF $$DIR^XBDIR("E","Press <RETURN> To Continue...")
+4 DO END
+5 QUIT
+6 ;
REPORT ;EP
+1 IF '(IO(0)=ACHSPTR)!($DATA(ACHSPPO))
SET ACHSIO=ACHSPTR
DO REPORT^ACHSACO2
+2 SET ACHSIO=IO(0)
+3 KILL ACHSPPO,ACHSPPC
+4 ;
+5 ;AREA OFFICE CONSOLIDATION REPORT
DO REPORT^ACHSACO2
+6 ;
+7 IF $DATA(^ACHSSVR)
IF $ORDER(^ACHSSVR(0))
Begin DoDot:1
+8 USE IO(0)
+9 WRITE !!?10,"PRINTING VENDOR SPECIAL REPORTS",!
+10 ;SELECT AND PRINT AO SPECIAL VENDOR REPORT
DO ^ACHSSVRP
End DoDot:1
+11 ;
+12 ;ACHS*3.1*13 6.14.2007 IHS/OIT/FCJ SET HEADER AND TRAILER RECORDS FOR UFMS
DO UFMS
+13 ;MOVE TO UNDOCUMENTED PARAMETER
DO FILEBLD
+14 ;SEND MESSAGE TO MAIL GROUP
DO SENDMSG
+15 DO XIT
+16 QUIT
+17 ;
FILEBLD ;
+1 IF +ACHSZFAC("TOTAL")>0
GOTO FILEBLDA
+2 USE IO(0)
+3 WRITE !!,"NO RECORDS CONSOLIDATED FROM FACILITIES ",!
+4 QUIT
+5 ;
FILEBLDA ;
+1 USE IO(0)
+2 ;
+3 ;CHECK UNDOCUMENTED PIECE (PARAMETER)
+4 ;ACHS*3.1*21 COMMENTED OUT NEXT LINE WILL NOT SEND TO TAPE, QUIT IF NO ARCHIEVE DIRECTORY DEFINNED
+5 ;G:'$L($$AOP^ACHS(2,13)) CHSTAR
+6 ;ACHS*3.1*21 THIS IS CALLED FR CHSTAR SO MV'D HERE
DO FILEDEL
+7 IF '$LENGTH($$AOP^ACHS(2,13))
QUIT
+8 ;
+9 ;UNDOCUMENTED PARAMETER
+10 WRITE !!," moving your facility files to '",$$AOP^ACHS(2,13),"'..."
+11 ;
+12 ;ACHS*3.1*21 CHANGED $$IM^ACHS TO ACHSPTH AND PTH IS SET FOR 252611
+13 FOR ACHSI=1:1
IF '$DATA(ACHSPLST(ACHSI))
QUIT
Begin DoDot:1
+14 WRITE !,$PIECE(ACHSPLST(ACHSI),U)
+15 ;I $$ASF^ACHS(DUZ(2))=252611 S X=$$MV^%ZISH($$EX^ACHS,$P(ACHSPLST(ACHSI),U),$$AOP^ACHS(2,13),$P(ACHSPLST(ACHSI),U)) ;ACHS*3.1*18
+16 ;E S X=$$MV^%ZISH($$IM^ACHS,$P(ACHSPLST(ACHSI),U),$$AOP^ACHS(2,13),$P(ACHSPLST(ACHSI),U)) ;ACHS*3.1*18
+17 SET X=$$MV^%ZISH(ACHSPTH,$PIECE(ACHSPLST(ACHSI),U),$$AOP^ACHS(2,13),$PIECE(ACHSPLST(ACHSI),U))
End DoDot:1
+18 ;
+19 QUIT
+20 ;
CHSTAR ;ASK OPERATOR ABOUT BACKING UP CHS PROCESSED FILES TO TAPE
+1 USE IO(0)
+2 IF '$$DIR^XBDIR("Y","Do you want to BACKUP processed CHS Facility Data to TAPE","Y","","","",1)
DO FILEDEL
QUIT
+3 ;
FLCP1 ;
+1 USE IO(0)
+2 WRITE !
+3 ;
+4 ;ARCHIVE TO TAPE ????? mikey questioned whether this works
+5 SET ACHSHCMD=("tar -cvft /dev/rct0 `cat /usr/spool/chsdata/achs.bk` ")
+6 ;
+7 ;IHS/ITSC/PMF 1/12/01 change call of vendor routine to call
+8 ;or routine in our namespace
+9 ;GET RETURN CODE
SET ACHSRTCD=$$TERMINAL^ACHSHCMD(ACHSHCMD)
+10 ;
+11 IF ACHSRTCD>0
WRITE !!?3,"BACKUP WAS UNSUCCESSFUL - FILES NOT DELETED FROM /usr/spool/uucppublic",!
QUIT
+12 ;
+13 ;
+14 ;ACHS*3.1*21 MODIFIED ENTIRE FILEDEL SECTION TO USE %ZISH AND USED ACHSPTH FOR THE DIRECTORY
FILEDEL ;DELETE FACILITY FILES PROCESSED FROM ACHSPTH
+1 ;FILES ARE BEING MOVED TO ARCHIVED NOT COPIED..ACHS*3.1*21
QUIT
+2 USE IO(0)
+3 IF '$$DIR^XBDIR("Y","Should CHS Facility Files processed from "_ACHSPTH_" be DELETED","N","","","",1)
QUIT
+4 SET L=0
SET L1=0
SET L2=0
FOR
SET L=$ORDER(ACHSPLST(L))
IF L'?1N.N
QUIT
Begin DoDot:1
+5 SET L1=$$DEL^%ZISH(ACHSPTH,ACHSPLST(L))
+6 IF L1>0
SET L2=1
End DoDot:1
+7 IF L2
WRITE !,"ALL FILES COULD NOT BE DELETED"
+8 IF '$TEST
WRITE !,"FILES DELETED...."
+9 ;
+10 QUIT
+11 ;
SENDMSG ;
+1 NEW XMSUB,XMDUZ,XMTEXT,XMY
+2 ;MAIL GROUP
SET XMB="ACHS AREA BALANCES"
+3 SET XMDUZ="CHS Area Office Consolidation"
SET XMSUB="CHS Facility Account Balances."
+4 SET XMTEXT="^TMP(""ACHSACO"",$J,"
+5 DO ^XMB
DO KILL^XM
+6 QUIT
+7 ;ACHS*3.1*13 6.14.2007 IHS/OIT/FCJ
UFMS ;SET BATCH HEADER AND RECORD FOR THE UFMS FILE, SAVE AND SEND FILE;
+1 SET X=$EXTRACT(DT,4,7)_$EXTRACT(DT,2,3)
+2 ;ACHS*3.1*14 10.02.2007 IHS/OIT/FCJ CHG 10 TO 11 IN NEXT LINE
+3 SET ^ACHSUFMS("COUNT")="4BATCH"_X_"Z3"_$EXTRACT(10000+^ACHSUFMS("COUNT"),2,5)_$JUSTIFY("",21)_"J"_$PIECE(^AUTTSITE(1,0),U,2)_$JUSTIFY("",6)_$EXTRACT(10000000000+^ACHSUFMS(0),2,11)_$JUSTIFY("",78)
+4 SET ^ACHSUFMS(0)="1BATCH"_X_"Z3"_$JUSTIFY("",121)
+5 QUIT
+6 ;
