ACHSPCC2 ; IHS/ITSC/PMF - CHS AREA SPLITOUT (2/5)(DHR) ;JUL 10, 2008
;;3.1;CONTRACT HEALTH MGMT SYSTEM;**5,14**;JUN 11,2001
;IHS/SET/GTH ACHS*3.1*5 12/06/2002 - Remove direct ref to non-package global.
;3.1*14 11.7.2007 IHS/OIT/FCJ Changed total display no longer using DHR's
S (ACHSFAC,ACHSRR,ACHSHASH,ACHSCT2)=0
K ACHSFTOT,ACHSFCT,AFSJFLG
U IO(0)
W !?10,"GENERATING DHR RECORDS FOR HAS ",!!
D WAIT^DICD
W:$E(IOST)="P" !
S (ACHSCT1,X)=$S($D(^ACHSPCC("COUNT")):^("COUNT"),1:100)
I X'=100 S ACHSCT1=$S(X>9999:100,X>8888:90,X>6666:80,X>4444:70,X>2222:50,X>500:30,1:5)
L1 ; Process a Facility.
S ACHSFAC=$O(^ACHSPCC(ACHSFAC))
G LEND:+ACHSFAC=0!(ACHSFAC>999999)
S (ACHSFTOT(ACHSFAC),ACHSFCT(ACHSFAC))=0
L2 ; Process DHRs for a Facility.
S ACHSRR=$O(^ACHSPCC(ACHSFAC,ACHSRR))
G L1:ACHSRR=""
I ACHSRR#2=0 G L3
S ACHSDES1=$E(^ACHSPCC(ACHSFAC,ACHSRR),8,12)
S ACHSZDOC=$E(^ACHSPCC(ACHSFAC,ACHSRR),13,25)
S ACHSCT2=ACHSCT2+1
I ACHSCT2#ACHSCT1=0 U IO(0) W $J(ACHSCT2,8)
L3 ; Check for CANCELLED documents and add up totals.
S X=$G(^ACHSPCC(ACHSFAC,ACHSRR))
I $E(X)'=2 G L5
S X1=$E(X,8,80),X="2"_ACHSEFDT_X1,^ACHSPCC(ACHSFAC,ACHSRR)=X
; FY/CORE/HAS -- CANCELATION TRANSLATION LOGIC
S (ACHSHLD1,ACHSHLD2)="" ; START WITH A CLEAN STATE
I $$AOP^ACHS(2,2)="CORE" G L9 ; DON'T X-LATE CANCELATIONS
S ACHSHLD1=X ; WE ARE NOT SURE OF A TRANSLATION YET
I ACHSDES1="05024" S X=$E(X,1,7)_"19"_$S($E(X,48,51)="2185":"2",1:"1")_"14"_ACHSZDOC_ACHSZDOC_$E(X,39,51)_"000000000000"_$E(X,64,80),^ACHSPCC(ACHSFAC,ACHSRR)=X
G L9
;
L5 ; Set the 2nd half of the DHR, if Doc was canceled.
I ACHSHLD1="" G L9 ; WE ARE NOT TRANSLATING
S ACHS2FY=$E(X,54,55) ; GET THE FISCAL YEAR CORE USES
I ACHS2FY<72!(ACHS2FY>98) D G L9 ; UNDO THE TRANSLATION
. S ACHSHLD2=$O(^ACHSPCC(ACHSFAC,ACHSRR),-1) ; BACKUP
. S ^ACHSPCC(ACHSFAC,ACHSHLD2)=ACHSHLD1 ; RESET TO ORIGINAL STATE
I ACHSDES1="05024" S X=$E(X,1,14)_"50XXXX"_$E(X,21,39)_"*10000"_$E(X,46,80),^ACHSPCC(ACHSFAC,ACHSRR)=X
L9 ;
I $E(X)=2 S ACHSHASH=ACHSHASH+$E(X,52,63),ACHSFTOT(ACHSFAC)=ACHSFTOT(ACHSFAC)+$E(X,52,63),ACHSFCT(ACHSFAC)=ACHSFCT(ACHSFAC)+1
G L2
;
LEND ;
U IO(0)
W !!,"TOTAL DHR RECORDS GENERATED = ",ACHSCT2,!
D RTRN^ACHS,HDR1
S ACHSHASH=$E(ACHSHASH+1000000000000,2,13),ACHSCT2=$E(ACHSCT2+10000,2,5)
K ACHSDES1,ACHSZDOC
S ACHSFAC=""
F S ACHSFAC=$O(ACHSFTOT(ACHSFAC)) Q:ACHSFAC="" D
. S X=ACHSFTOT(ACHSFAC)/100,X2=2,X3=16
. D COMMA^%DTC
. W ?10,$E($P(^DIC(4,$O(^AUTTLOC("C",ACHSFAC,0)),0),U),1,30),?46,$J(ACHSFCT(ACHSFAC),5),?55,X,!!
. I $Y>(IOSL-6) D RTRN^ACHS,HDR1
.Q
W ?10,$E(Y,1,60)
S X=+ACHSHASH/100,X2="2$",X3=16
D COMMA^%DTC
W !!?15,"TOTAL CHS TRANSACTIONS",?51-$L($J(ACHSCT2,0,0)),$J(ACHSCT2,0,0),?55,X,!!?10,"NUMBER OF OUTPUT DHR RECORDS = ",?46,$J((ACHSCT2+2)*2,5)
S ACHSJCLC=8
W !!?10,"NUMBER OF JCL RECORDS = ",?46,$J(ACHSJCLC,5),!!?10,$E(Y,1,41)
S ACHSTXCT=((ACHSCT2+2)*2)+ACHSJCLC
W !?15,"TOTAL RECORDS TO TRANSMIT = ",?46,$J(ACHSTXCT,5),!!
D RTRN^ACHS
W @IOF
;I $P($G(^AFSHPARM(DUZ(2),0)),U,5)["N" D ^%ZISC I 1 ; Allow posting of DHR Date to 1166;IHS/SET/GTH ACHS*3.1*5 12/06/2002
I $$GET1^DIQ(9002322.3,DUZ(2),1.03)["N" D ^%ZISC I 1 ; Allow posting of DHR Date to 1166 ;IHS/SET/GTH ACHS*3.1*5 12/06/2002
E S ACHSPTRD=IO ; Allow 1166 posting.
D HOME^%ZIS
K ACHSFTOT
Q
;
HDR1 ;
U IO
S (X,Y)="",$P(X,"*",71)="",$P(Y,"-",69)=""
W @IOF,!?5,X,!?5,"*",?10,"C H S DATA SPLIT-OUT (EXPORT) FOR: ",$E($$LOC^ACHS,1,25),?74,"*",!?5,"*",?5,$E(DT,4,5),"-",$E(DT,6,7),"-",$E(DT,2,3),?22,"TRANSACTION TOTALS BY FACILITY",?74,"*",!
;ACHS*3.1*14 11.7.2007 IHS/OIT/FCJ DISPLAY IS NOT TOTAL OF BC RECORDS BUT OF THE DHR TOTALS SO REMOVED FROM NEXT LINE
;W ?5,"*",Y,"*",!?5,"*"," THE DESTINATION OF THESE DATA RECORDS IS: ",$S('($$AOP^ACHS(2,8)="Y"):"PARKLAWN COMPUTER CENTER",$$AOP^ACHS(2,8)="Y":"BLUE CROSS/SHIELD OF NM",1:" "),?74,"*",!
W ?5,"*",Y,"*",!?5,"*"," THE DESTINATION OF THESE DATA RECORDS IS: ",$S('($$AOP^ACHS(2,8)="Y"):"PARKLAWN COMPUTER CENTER",$$AOP^ACHS(2,8)="Y":"DHR DATA",1:" "),?74,"*",!
W ?5,"*",Y,"*",!?5,"*",?10,"NAME OF FACILITY",?44,"NUMB TRNS",?60,"DOLLAR AMT",?74,"*",!?5,X,!!
Q
;
ACHSPCC2 ; IHS/ITSC/PMF - CHS AREA SPLITOUT (2/5)(DHR) ;JUL 10, 2008
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**5,14**;JUN 11,2001
+2 ;IHS/SET/GTH ACHS*3.1*5 12/06/2002 - Remove direct ref to non-package global.
+3 ;3.1*14 11.7.2007 IHS/OIT/FCJ Changed total display no longer using DHR's
+4 SET (ACHSFAC,ACHSRR,ACHSHASH,ACHSCT2)=0
+5 KILL ACHSFTOT,ACHSFCT,AFSJFLG
+6 USE IO(0)
+7 WRITE !?10,"GENERATING DHR RECORDS FOR HAS ",!!
+8 DO WAIT^DICD
+9 IF $EXTRACT(IOST)="P"
WRITE !
+10 SET (ACHSCT1,X)=$SELECT($DATA(^ACHSPCC("COUNT")):^("COUNT"),1:100)
+11 IF X'=100
SET ACHSCT1=$SELECT(X>9999:100,X>8888:90,X>6666:80,X>4444:70,X>2222:50,X>500:30,1:5)
L1 ; Process a Facility.
+1 SET ACHSFAC=$ORDER(^ACHSPCC(ACHSFAC))
+2 IF +ACHSFAC=0!(ACHSFAC>999999)
GOTO LEND
+3 SET (ACHSFTOT(ACHSFAC),ACHSFCT(ACHSFAC))=0
L2 ; Process DHRs for a Facility.
+1 SET ACHSRR=$ORDER(^ACHSPCC(ACHSFAC,ACHSRR))
+2 IF ACHSRR=""
GOTO L1
+3 IF ACHSRR#2=0
GOTO L3
+4 SET ACHSDES1=$EXTRACT(^ACHSPCC(ACHSFAC,ACHSRR),8,12)
+5 SET ACHSZDOC=$EXTRACT(^ACHSPCC(ACHSFAC,ACHSRR),13,25)
+6 SET ACHSCT2=ACHSCT2+1
+7 IF ACHSCT2#ACHSCT1=0
USE IO(0)
WRITE $JUSTIFY(ACHSCT2,8)
L3 ; Check for CANCELLED documents and add up totals.
+1 SET X=$GET(^ACHSPCC(ACHSFAC,ACHSRR))
+2 IF $EXTRACT(X)'=2
GOTO L5
+3 SET X1=$EXTRACT(X,8,80)
SET X="2"_ACHSEFDT_X1
SET ^ACHSPCC(ACHSFAC,ACHSRR)=X
+4 ; FY/CORE/HAS -- CANCELATION TRANSLATION LOGIC
+5 ; START WITH A CLEAN STATE
SET (ACHSHLD1,ACHSHLD2)=""
+6 ; DON'T X-LATE CANCELATIONS
IF $$AOP^ACHS(2,2)="CORE"
GOTO L9
+7 ; WE ARE NOT SURE OF A TRANSLATION YET
SET ACHSHLD1=X
+8 IF ACHSDES1="05024"
SET X=$EXTRACT(X,1,7)_"19"_$SELECT($EXTRACT(X,48,51)="2185":"2",1:"1")_"14"_ACHSZDOC_ACHSZDOC_$EXTRACT(X,39,51)_"000000000000"_$EXTRACT(X,64,80)
SET ^ACHSPCC(ACHSFAC,ACHSRR)=X
+9 GOTO L9
+10 ;
L5 ; Set the 2nd half of the DHR, if Doc was canceled.
+1 ; WE ARE NOT TRANSLATING
IF ACHSHLD1=""
GOTO L9
+2 ; GET THE FISCAL YEAR CORE USES
SET ACHS2FY=$EXTRACT(X,54,55)
+3 ; UNDO THE TRANSLATION
IF ACHS2FY<72!(ACHS2FY>98)
Begin DoDot:1
+4 ; BACKUP
SET ACHSHLD2=$ORDER(^ACHSPCC(ACHSFAC,ACHSRR),-1)
+5 ; RESET TO ORIGINAL STATE
SET ^ACHSPCC(ACHSFAC,ACHSHLD2)=ACHSHLD1
End DoDot:1
GOTO L9
+6 IF ACHSDES1="05024"
SET X=$EXTRACT(X,1,14)_"50XXXX"_$EXTRACT(X,21,39)_"*10000"_$EXTRACT(X,46,80)
SET ^ACHSPCC(ACHSFAC,ACHSRR)=X
L9 ;
+1 IF $EXTRACT(X)=2
SET ACHSHASH=ACHSHASH+$EXTRACT(X,52,63)
SET ACHSFTOT(ACHSFAC)=ACHSFTOT(ACHSFAC)+$EXTRACT(X,52,63)
SET ACHSFCT(ACHSFAC)=ACHSFCT(ACHSFAC)+1
+2 GOTO L2
+3 ;
LEND ;
+1 USE IO(0)
+2 WRITE !!,"TOTAL DHR RECORDS GENERATED = ",ACHSCT2,!
+3 DO RTRN^ACHS
DO HDR1
+4 SET ACHSHASH=$EXTRACT(ACHSHASH+1000000000000,2,13)
SET ACHSCT2=$EXTRACT(ACHSCT2+10000,2,5)
+5 KILL ACHSDES1,ACHSZDOC
+6 SET ACHSFAC=""
+7 FOR
SET ACHSFAC=$ORDER(ACHSFTOT(ACHSFAC))
IF ACHSFAC=""
QUIT
Begin DoDot:1
+8 SET X=ACHSFTOT(ACHSFAC)/100
SET X2=2
SET X3=16
+9 DO COMMA^%DTC
+10 WRITE ?10,$EXTRACT($PIECE(^DIC(4,$ORDER(^AUTTLOC("C",ACHSFAC,0)),0),U),1,30),?46,$JUSTIFY(ACHSFCT(ACHSFAC),5),?55,X,!!
+11 IF $Y>(IOSL-6)
DO RTRN^ACHS
DO HDR1
+12 QUIT
End DoDot:1
+13 WRITE ?10,$EXTRACT(Y,1,60)
+14 SET X=+ACHSHASH/100
SET X2="2$"
SET X3=16
+15 DO COMMA^%DTC
+16 WRITE !!?15,"TOTAL CHS TRANSACTIONS",?51-$LENGTH($JUSTIFY(ACHSCT2,0,0)),$JUSTIFY(ACHSCT2,0,0),?55,X,!!?10,"NUMBER OF OUTPUT DHR RECORDS = ",?46,$JUSTIFY((ACHSCT2+2)*2,5)
+17 SET ACHSJCLC=8
+18 WRITE !!?10,"NUMBER OF JCL RECORDS = ",?46,$JUSTIFY(ACHSJCLC,5),!!?10,$EXTRACT(Y,1,41)
+19 SET ACHSTXCT=((ACHSCT2+2)*2)+ACHSJCLC
+20 WRITE !?15,"TOTAL RECORDS TO TRANSMIT = ",?46,$JUSTIFY(ACHSTXCT,5),!!
+21 DO RTRN^ACHS
+22 WRITE @IOF
+23 ;I $P($G(^AFSHPARM(DUZ(2),0)),U,5)["N" D ^%ZISC I 1 ; Allow posting of DHR Date to 1166;IHS/SET/GTH ACHS*3.1*5 12/06/2002
+24 ; Allow posting of DHR Date to 1166 ;IHS/SET/GTH ACHS*3.1*5 12/06/2002
IF $$GET1^DIQ(9002322.3,DUZ(2),1.03)["N"
DO ^%ZISC
IF 1
+25 ; Allow 1166 posting.
IF '$TEST
SET ACHSPTRD=IO
+26 DO HOME^%ZIS
+27 KILL ACHSFTOT
+28 QUIT
+29 ;
HDR1 ;
+1 USE IO
+2 SET (X,Y)=""
SET $PIECE(X,"*",71)=""
SET $PIECE(Y,"-",69)=""
+3 WRITE @IOF,!?5,X,!?5,"*",?10,"C H S DATA SPLIT-OUT (EXPORT) FOR: ",$EXTRACT($$LOC^ACHS,1,25),?74,"*",!?5,"*",?5,$EXTRACT(DT,4,5),"-",$EXTRACT(DT,6,7),"-",$EXTRACT(DT,2,3),?22,"TRANSACTION TOTALS BY FACILITY",?74,"*",!
+4 ;ACHS*3.1*14 11.7.2007 IHS/OIT/FCJ DISPLAY IS NOT TOTAL OF BC RECORDS BUT OF THE DHR TOTALS SO REMOVED FROM NEXT LINE
+5 ;W ?5,"*",Y,"*",!?5,"*"," THE DESTINATION OF THESE DATA RECORDS IS: ",$S('($$AOP^ACHS(2,8)="Y"):"PARKLAWN COMPUTER CENTER",$$AOP^ACHS(2,8)="Y":"BLUE CROSS/SHIELD OF NM",1:" "),?74,"*",!
+6 WRITE ?5,"*",Y,"*",!?5,"*"," THE DESTINATION OF THESE DATA RECORDS IS: ",$SELECT('($$AOP^ACHS(2,8)="Y"):"PARKLAWN COMPUTER CENTER",$$AOP^ACHS(2,8)="Y":"DHR DATA",1:" "),?74,"*",!
+7 WRITE ?5,"*",Y,"*",!?5,"*",?10,"NAME OF FACILITY",?44,"NUMB TRNS",?60,"DOLLAR AMT",?74,"*",!?5,X,!!
+8 QUIT
+9 ;
