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