Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACHSACOA

ACHSACOA.m

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