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

ACHSPCC4.m

Go to the documentation of this file. 
  1. ACHSPCC4 ; IHS/ITSC/PMF - CHS AREA SPLITOUT (4/5)(EOJ) ; [ 12/06/2002  10:36 AM ]
  1.  ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**5,21,23**;JUN 11,2001;Build 43
  1.  ;IHS/SET/GTH ACHS*3.1*5 12/06/2002 - Remove direct ref to non-package global.
  1. END ;EP
  1.  I $D(ACHSJFLG)!(ACHSFLG) G END1
  1.  S:$D(^ACHSPCC("COUNT")) ^ACHSZOCT=$G(^ACHSPCC("COUNT"))
  1.  K ^ACHSPCC("COUNT")
  1. BKASK ;
  1.  U IO(0)
  1.  G END1  ;ACHS*3.1*21  NO LONGER BACKING UP TO TAPE
  1.  G END1:'$$DIR^XBDIR("Y","Do you want to backup CHS files for THIS Export to TAPE","N","","","",2)
  1.  I $D(DTOUT)!$D(DUOUT) G END1
  1. COPYZ ;
  1.  K ACHSJFLG
  1.  ;ACHS*3.1*21 MODIFED TO TEST FOR OS
  1.  ;S ACHSRTCD=999,ACHSDTJL=$E(DT,2,3)_$$JDT^ACHS(DT,1),ACHSZDIR="/usr/spool/chsdata/",ACHSZFN="chs????."_ACHSDTJL,ACHSDTYP="C",ACHSEXFN="CHS TX FILES"
  1.  S ACHSRTCD=999,ACHSDTJL=$E(DT,2,3)_$$JDT^ACHS(DT,1)
  1.  S ACHSZFN="chs????."_ACHSDTJL,ACHSDTYP="C",ACHSEXFN="CHS TX FILES"
  1.  S ACHSZDIR=$S($$OS^ACHS=2:"c:\usr\spool\chsdata",1:"/usr/spool/chsdata")
  1.  D TARBKUP^ACHSARCH
  1.  I ACHSRTCD=0 G END1
  1.  U IO(0)
  1.  I '$$DIR^XBDIR("Y","Do you want to try BACKUP files to "_ACHSDNAM_" AGAIN?","Y","","","",2) S ACHSJFLG=1 U IO(0) W *7,!!,"WARNING  ****** -- TX FILES HAVE NOT BEEN SAVED TO TAPE" G END
  1.  U IO(0)
  1.  W !!,*7,"Make sure an appropriate TAPE (Write Enabled) is in the ",ACHSDNAM," DRIVE",!
  1.  S Y=$$DIR^XBDIR("E")
  1.  G END1:Y=0,COPYZ:Y=1
  1. END1 ;
  1.  G END3:$D(ACHSJFLG)!$D(ACHSFLG),END3:'$D(ACHSDHRN)
  1. END2 ;
  1.  ;I $D(^AFSHPARM(DUZ(2),0)),$P(^(0),U,5)["Y",ACHSZFN["chsdh",$P($G(^ACHSAOP(DUZ(2),2)),U,12)="Y" D;IHS/SET/GTH ACHS*3.1*5 12/06/2002
  1.  I $$GET1^DIQ(9002322.3,DUZ(2),1.03)["Y",ACHSZFN["chsdh",$P($G(^ACHSAOP(DUZ(2),2)),U,12)="Y" D  ;IHS/SET/GTH ACHS*3.1*5 12/06/2002
  1.  . S %="TX"
  1.  . Q:'$L($T(@%^AFSLODF))
  1.  . U IO(0)
  1.  . W !,"Begin Posting to 1166 Open Document file..."
  1.  . S AFSXPFN=ACHSZFN
  1.  . D TX^AFSLODF ; Post 1166 open document file
  1.  . K AFSXPFN
  1.  . U IO(0)
  1.  . W !,"End Posting to 1166 Open Document file..."
  1.  .Q
  1.  S ^ACHSPCC("ODF-POST")=$$HTFM^XLFDT($H)
  1. END3 ;
  1.  D ^%ZISC
  1. END5 ; Kill vars, do *PCC5, quit.
  1.  K ACHSAREA,ACHSAPN,ACHSPRN,ACHSPSWD,ACHSUID,AUOK,ACHSCT1,ACHSCT2,ACHSPFX,ACHSDESC,DX,DY,ACHSEFDT,ACHSFCT,ACHSGLBL,ACHSHASH
  1.  K J,L,ACHSMED,N,R,ACHSREF,ACHSRR,ACHSSFX1,ACHSSUF,X1,ACHSXY
  1.  K DIR,ACHSFIRN,ACHSQUIT,X,Y,DIC
  1.  I $D(ACHSGCTR) D:ACHSGCTR=6 RTRN^ACHS,^ACHSPCC5 K ACHSGCTR
  1.  K ACHSIO
  1.  Q
  1.  ;
  1. JOBABEND ;EP
  1.  S ACHSFLG=1
  1.  W !!?10,"ABNORMAL END OF AO CHS SPLIT-OUT / EXPORT",!
  1. ENTRETRN ;EP
  1.  W !
  1.  I $$DIR^XBDIR("E","ENTER <RETURN> TO CONTINUE")
  1.  G END
  1.  ;
  1. ERROR ; ENTRY POINT.
  1.  U IO(0)
  1.  W !,"AN ERROR HAS OCCURRED == PLEASE DO AGAIN"
  1.  D ^%ZISC
  1.  G END
  1.  ;
  1. EXIT1 ;EP
  1.  W !!?10,"JOB TERMINATED BY OPERATOR"
  1.  G END
  1.  ;
  1. PCCHJCL ;EP - Generate Head JCL for Parklawn Computer Center.
  1.  S ACHSX="",X=ACHSX_"//"_ACHSUID_ACHSAPN_"DHR JOB (OFM,"_ACHSUID_ACHSAPN_",1,0),'"_ACHSAREA_"',CLASS=E"
  1.  D PADWRITE^ACHSPCC3
  1.  S X=ACHSX_"/*PASS   "_ACHSPSWD
  1.  D PADWRITE^ACHSPCC3
  1.  S X=ACHSX_"/*ROUTE  PRINT RMT"_ACHSPRN
  1.  D PADWRITE^ACHSPCC3
  1.  S X=ACHSX_"//ESYLIB JCLLIB ORDER=(OFM.PROCLIB)" ;UPDATE PCC JCL CARD
  1.  D PADWRITE^ACHSPCC3
  1.  S X=ACHSX_"//S1 EXEC HASRADAP,AP="_ACHSAPN
  1.  D PADWRITE^ACHSPCC3
  1.  S X=ACHSX_"//HASRAD10.DHRIN DD *"
  1.  D PADWRITE^ACHSPCC3
  1.  S X="1BATCH"_$E(DT,4,7)_$E(DT,2,3)_"Z3"_$J("",25)_ACHSPFX
  1.  D PADWRITE^ACHSPCC3
  1.  S X="",$P(X,"9",21)="",X=$J("",60)_X
  1.  D PADWRITE^ACHSPCC3
  1.  Q
  1.  ;
  1. PCCTJCL ;EP - Generate Tail JCL for Parklawn Computer Center.
  1.  S ACHSX="",X="4BATCH"_$E(DT,4,7)_$E(DT,2,3)_"Z3"_ACHSCT2_$J("",21)_ACHSPFX_$J("",9)_ACHSHASH
  1.  D PADWRITE^ACHSPCC3
  1.  S X="",$P(X,"9",21)="",X=$J("",60)_X
  1.  D PADWRITE^ACHSPCC3
  1.  Q:ACHSGCTR=2
  1.  S X=ACHSX_"/*"
  1.  D PADWRITE^ACHSPCC3
  1.  S X=ACHSX_"//"
  1.  D PADWRITE^ACHSPCC3
  1.  ;I $$AOP^ACHS(2,8)="Y" S X="/*" D PADWRITE^ACHSPCC3
  1.  Q
  1.  ;
  1. FIHJCL ;EP - Generate Head JCL for Fiscal Intermediary.
  1. TEST1 ; S X="//IHS003 JOB (1103,SBSP),'PRODUCTION',CLASS=Q,MSGCLASS=H" D PADWRITE^ACHSPCC3
  1. TEST2 ; S X="//STEP01 EXEC IHS003,AREA=RMT"_$E(1000+ACHSFIRN,2,4) D PADWRITE^ACHSPCC3
  1. TEST3 ; S X="//STEP010.SYSUT1 DD *" D PADWRITE^ACHSPCC3
  1. PROD1 S X="//IHS001 JOB (1103,SBSP),'PRODUCTION',CLASS=Q,MSGCLASS=H" D PADWRITE^ACHSPCC3
  1. PROD2 S X="//STEP01 EXEC IHS001,AREA=RMT"_$E(1000+ACHSFIRN,2,4) D PADWRITE^ACHSPCC3
  1. PROD3 S X="//STEP010.IHSODOC DD *" D PADWRITE^ACHSPCC3
  1.  ;  REMOVE COMMENTS FROM PROD1-PROD3 AND SUBSTITUTE FOR TEST1-TEST3
  1.  ;  THIS ENABLES BC/BS OF NM TO AUTOMATICALLY PROCESS YOUR DATA
  1.  S X="1BATCH"_$E(DT,4,7)_$E(DT,2,3)_"Z3"_$J("",25)_ACHSPFX
  1.  D PADWRITE^ACHSPCC3
  1.  Q
  1.  ;
  1. FITJCL ;EP - Generate Tail JCL for Fiscal Intemediary.
  1.  S X="/*"
  1.  D PADWRITE^ACHSPCC3
  1.  Q
  1.  ;
  1. DPSHJCL ;EP - Generate Head JCL for Data center.
  1.  S X="* $$ JOB JNM=TRANTAPE,CLASS=A,DISP=H,PRI=1,USER='DTR,"_$P(^AUTTAREA($P(^AUTTLOC(DUZ(2),0),U,4),0),U,2)_",P,OPR'"
  1.  D PADWRITE^ACHSPCC3
  1.  S X="* $$ LST LST=X'01B',REMOTE="_$P(^AUTTSITE(1,0),U,3)_",JSEP=0"
  1.  D PADWRITE^ACHSPCC3
  1.  S X="* $$ SLI S.TRANTAPE"
  1.  D PADWRITE^ACHSPCC3
  1.  S X="* $$ DATA NCRDATA"
  1.  I ACHSGLBL="^ACHSPG2" S X=X_" CRV003"   ;ACHS*3.1*23
  1.  D PADWRITE^ACHSPCC3
  1.  Q
  1.  ;
  1. DPSTJCL ;EP - Generate Tail JCL for Data center.
  1.  F X="/*","/&","* $$ EOJ" D PADWRITE^ACHSPCC3
  1.  Q
  1.  ;