ACHSPCC1 ; IHS/ITSC/TPF/PMF - CHS AREA SPLITOUT (1/5) ; JUL 10, 2008
;;3.1;CONTRACT HEALTH MGMT SYSTEM;**14,21**;JUN 11,2001;Build 43
;ACHS*3.1*14 IHS/OIT/FCJ call new routine for printing UFMS and FI totals
;
D HOME^%ZIS
S ACHSIO=IO
I $D(^ACHSPCC("ODF-POST")) D Q
. U IO(0)
. W !?10,"CHS FACILITY FILES ALREADY PROCESSED ON ",$$FMTE^XLFDT($P(^ACHSPCC("ODF-POST"),U,1)),!!?10,"JOB CANCELLED"
. D JOBABEND^ACHSPCC4
.Q
S X=$P(^AUTTLOC(DUZ(2),0),U,4),ACHSPFX=$P(^AUTTAREA(X,0),U,4),ACHSAREA=$P(^(0),U)
S ACHSAPN=$P(^AUTTSITE(1,0),U,2)
I ACHSAPN']"" D Q
. W *7,!,"ACCOUNTING POINT NUMBER is missing from RPMS SITE file...",!
. D JOBABEND^ACHSPCC4
.Q
S X=$O(^AUTTTEL(DUZ(2),1,"B","PCC",""))
I +X<1 D ERR("PCC") Q
S ACHSPRN=$P(^AUTTTEL(DUZ(2),1,X,0),U,2)
I +ACHSPRN<1 D ERR("RJEPCC") Q
I '$D(^AUTTTEL(DUZ(2),1,"B","BCS")) D ERR("BCS") Q
S X=$O(^AUTTTEL(DUZ(2),1,"B","BCS",""))
I '$D(^AUTTTEL(DUZ(2),1,X,0)) D ERR("BCS") Q
S ACHSFIRN=$P(^AUTTTEL(DUZ(2),1,X,0),U,2)
I +ACHSFIRN<1 D ERR("RJEBCS") Q
I +ACHSPFX>0,(+ACHSPFX<300!(+ACHSPFX>399)) D CPFXERR Q
I +ACHSPFX=0,$E(ACHSPFX)'="J" D CPFXERR Q
I $L(ACHSPFX)'=3 D CPFXERR Q
W !,$$C^XBFUNC("AREA PREFIX="_$E(ACHSPFX,2,3)),!
U IO(0)
;ACHS*3.1*21 CHANGED HAS/CORE TO UFMS
;W !,"Your CHS FACILITY DHR Transactions Should be TRANSMITTED to:",!?10,"(1) HAS and/or CORE",!?10,$S($$AOP^ACHS(2,8)="Y":"(2) Fiscal Intermediary",1:" ")
W !,"Your CHS FACILITY DHR Transactions Should be TRANSMITTED to:"
W !?10,"(1) United Finacial Management System for Federal Facilities"
W !?10,$S($$AOP^ACHS(2,3)="Y":"(2) Fiscal Intermediary",1:" ")
U IO(0)
I '$$DIR^XBDIR("E","","","","","",2) D JOBABEND^ACHSPCC4 Q
I $D(DUOUT)!$D(DTOUT) D JOBABEND^ACHSPCC4 Q
EFFD ;
S ACHSEFDT=$$DIR^XBDIR("D","Enter Effective Transaction Date ",$$FMTE^XLFDT(DT),"","The effective date will be placed in all DHR records","^S Y=""??"",%DT=""E"" D ^%DT",2)
I $D(DTOUT)!$D(DUOUT)!(ACHSEFDT<1) D JOBABEND^ACHSPCC4 Q
I ACHSEFDT>DT W *7," CAN'T BE FUTURE DATE" G EFFD
S ACHSEFDT=$E(Y,4,7)_$E(Y,2,3)
W !
S %ZIS("A")="ENTER DEVICE # FOR SUMMARY REPORT ",%ZIS="P"
D ^%ZIS
K %ZIS
I POP D HOME^%ZIS D JOBABEND^ACHSPCC4 Q
S ACHSPTRD=IO,ACHSCCTR="PCC"
;ACHS*3.1*14 11/15/2007 IHS/OIT/FCJ REMOVED CALL TO ACHSPCC2 AND NOW CALLING ACHSPCCR
;D ^ACHSPCC2
S ACHSCT2=0,ACHSHASH=0 D ^ACHSPCCR
Q:$D(ACHSFLG)
D ^ACHSPCC3
Q
;
CPFXERR ;
W *7,!!?12," CAN NUMBER PREFIX NOT CORRECTLY DEFINED FOR THIS FACILITY",!,"PREFIX = '",ACHSPFX,"'",!!?35,"JOB CANCELLED",!!
D ENTRETRN^ACHSPCC4
Q
;
PCC ;;COMPUTER CENTER entry Missing for ITS (Parklawn)
RJEPCC ;;Default RJE # for ITS (Parklawn) Missing
BCS ;;COMPUTER CENTER entry Missing for the Fiscal Intemediary
RJEBCS ;;Default RJE # for the Fiscal Intemediary Missing
ERR(X) ;
W *7,!!?10,$P($T(@X),";",3)
W !?10,"In IHS COMMUNICATIONS PARAMETERS file for ",$$LOC^ACHS
D JOBABEND^ACHSPCC4
Q
;
ACHSPCC1 ; IHS/ITSC/TPF/PMF - CHS AREA SPLITOUT (1/5) ; JUL 10, 2008
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**14,21**;JUN 11,2001;Build 43
+2 ;ACHS*3.1*14 IHS/OIT/FCJ call new routine for printing UFMS and FI totals
+3 ;
+4 DO HOME^%ZIS
+5 SET ACHSIO=IO
+6 IF $DATA(^ACHSPCC("ODF-POST"))
Begin DoDot:1
+7 USE IO(0)
+8 WRITE !?10,"CHS FACILITY FILES ALREADY PROCESSED ON ",$$FMTE^XLFDT($PIECE(^ACHSPCC("ODF-POST"),U,1)),!!?10,"JOB CANCELLED"
+9 DO JOBABEND^ACHSPCC4
+10 QUIT
End DoDot:1
QUIT
+11 SET X=$PIECE(^AUTTLOC(DUZ(2),0),U,4)
SET ACHSPFX=$PIECE(^AUTTAREA(X,0),U,4)
SET ACHSAREA=$PIECE(^(0),U)
+12 SET ACHSAPN=$PIECE(^AUTTSITE(1,0),U,2)
+13 IF ACHSAPN']""
Begin DoDot:1
+14 WRITE *7,!,"ACCOUNTING POINT NUMBER is missing from RPMS SITE file...",!
+15 DO JOBABEND^ACHSPCC4
+16 QUIT
End DoDot:1
QUIT
+17 SET X=$ORDER(^AUTTTEL(DUZ(2),1,"B","PCC",""))
+18 IF +X<1
DO ERR("PCC")
QUIT
+19 SET ACHSPRN=$PIECE(^AUTTTEL(DUZ(2),1,X,0),U,2)
+20 IF +ACHSPRN<1
DO ERR("RJEPCC")
QUIT
+21 IF '$DATA(^AUTTTEL(DUZ(2),1,"B","BCS"))
DO ERR("BCS")
QUIT
+22 SET X=$ORDER(^AUTTTEL(DUZ(2),1,"B","BCS",""))
+23 IF '$DATA(^AUTTTEL(DUZ(2),1,X,0))
DO ERR("BCS")
QUIT
+24 SET ACHSFIRN=$PIECE(^AUTTTEL(DUZ(2),1,X,0),U,2)
+25 IF +ACHSFIRN<1
DO ERR("RJEBCS")
QUIT
+26 IF +ACHSPFX>0
IF (+ACHSPFX<300!(+ACHSPFX>399))
DO CPFXERR
QUIT
+27 IF +ACHSPFX=0
IF $EXTRACT(ACHSPFX)'="J"
DO CPFXERR
QUIT
+28 IF $LENGTH(ACHSPFX)'=3
DO CPFXERR
QUIT
+29 WRITE !,$$C^XBFUNC("AREA PREFIX="_$EXTRACT(ACHSPFX,2,3)),!
+30 USE IO(0)
+31 ;ACHS*3.1*21 CHANGED HAS/CORE TO UFMS
+32 ;W !,"Your CHS FACILITY DHR Transactions Should be TRANSMITTED to:",!?10,"(1) HAS and/or CORE",!?10,$S($$AOP^ACHS(2,8)="Y":"(2) Fiscal Intermediary",1:" ")
+33 WRITE !,"Your CHS FACILITY DHR Transactions Should be TRANSMITTED to:"
+34 WRITE !?10,"(1) United Finacial Management System for Federal Facilities"
+35 WRITE !?10,$SELECT($$AOP^ACHS(2,3)="Y":"(2) Fiscal Intermediary",1:" ")
+36 USE IO(0)
+37 IF '$$DIR^XBDIR("E","","","","","",2)
DO JOBABEND^ACHSPCC4
QUIT
+38 IF $DATA(DUOUT)!$DATA(DTOUT)
DO JOBABEND^ACHSPCC4
QUIT
EFFD ;
+1 SET ACHSEFDT=$$DIR^XBDIR("D","Enter Effective Transaction Date ",$$FMTE^XLFDT(DT),"","The effective date will be placed in all DHR records","^S Y=""??"",%DT=""E"" D ^%DT",2)
+2 IF $DATA(DTOUT)!$DATA(DUOUT)!(ACHSEFDT<1)
DO JOBABEND^ACHSPCC4
QUIT
+3 IF ACHSEFDT>DT
WRITE *7," CAN'T BE FUTURE DATE"
GOTO EFFD
+4 SET ACHSEFDT=$EXTRACT(Y,4,7)_$EXTRACT(Y,2,3)
+5 WRITE !
+6 SET %ZIS("A")="ENTER DEVICE # FOR SUMMARY REPORT "
SET %ZIS="P"
+7 DO ^%ZIS
+8 KILL %ZIS
+9 IF POP
DO HOME^%ZIS
DO JOBABEND^ACHSPCC4
QUIT
+10 SET ACHSPTRD=IO
SET ACHSCCTR="PCC"
+11 ;ACHS*3.1*14 11/15/2007 IHS/OIT/FCJ REMOVED CALL TO ACHSPCC2 AND NOW CALLING ACHSPCCR
+12 ;D ^ACHSPCC2
+13 SET ACHSCT2=0
SET ACHSHASH=0
DO ^ACHSPCCR
+14 IF $DATA(ACHSFLG)
QUIT
+15 DO ^ACHSPCC3
+16 QUIT
+17 ;
CPFXERR ;
+1 WRITE *7,!!?12," CAN NUMBER PREFIX NOT CORRECTLY DEFINED FOR THIS FACILITY",!,"PREFIX = '",ACHSPFX,"'",!!?35,"JOB CANCELLED",!!
+2 DO ENTRETRN^ACHSPCC4
+3 QUIT
+4 ;
PCC ;;COMPUTER CENTER entry Missing for ITS (Parklawn)
RJEPCC ;;Default RJE # for ITS (Parklawn) Missing
BCS ;;COMPUTER CENTER entry Missing for the Fiscal Intemediary
RJEBCS ;;Default RJE # for the Fiscal Intemediary Missing
ERR(X) ;
+1 WRITE *7,!!?10,$PIECE($TEXT(@X),";",3)
+2 WRITE !?10,"In IHS COMMUNICATIONS PARAMETERS file for ",$$LOC^ACHS
+3 DO JOBABEND^ACHSPCC4
+4 QUIT
+5 ;
