ACHSPCCR ; IHS/ITSC/PMF - CHS AREA SPLITOUT REPORT ;JUL 10, 2008
;;3.1;CONTRACT HEALTH MGMT SYSTEM;**14,21**;JUN 11,2001;Build 43
;ACHS*3.1*14 11/08/2007 IHS/OIT/FCJ NEW ROUTINE TO PRINT TOTAL RECORDS FOR UFMS AND BCBS
ST ;EP
D BCBS,UFMS,HDR1,PRT
S ^ACHSPCC("PROC")="S" ;ACHS*3.1*21
G EXIT
BCBS ;DATA FOR BCBS
;achsbrct-batch record count achsbdct=batch dollar amount achsrct-record count achsdct=dollar amount
S (ACHSBRCT,ACHSBDCT,ACHSRCT,ACHSDCT,ACHSFIN)=0
I $D(^ACHSBCBS) S ACHS="" F S ACHS=$O(^ACHSBCBS(ACHS)) Q:ACHS="" D
.S ACHSREC=^ACHSBCBS(ACHS)
.I $E(ACHSREC,1,2)="AA" D FACBC Q
.Q:$E(ACHSREC,1,2)'="5A"
.I $E(ACHSREC,1,2)="5A"
.S ACHSRCT=ACHSRCT+1
.S ACHSDCT=$E(ACHSREC,69,76)+ACHSDCT
.S ACHSFIN=$E(ACHSREC,5,7)
S ACHSBBC=ACHSBRCT_U_ACHSBDCT
Q
UFMS ;DATA FOR UFMS
S (ACHSBRCT,ACHSBDCT,ACHSRCT,ACHSDCT)=0
I $D(^ACHSUFMS) S ACHS=0 F S ACHS=$O(^ACHSUFMS(ACHS)) Q:ACHS'?1N.N D
.S ACHSREC=^ACHSUFMS(ACHS)
.S ACHSFIN=$E(ACHSREC,27,29)
.S ACHSDCT=$E(ACHSREC,52,63),Y=$E(ACHSREC,11)
.S ACHSDCT=$S(Y=2:"-"_ACHSDCT,1:ACHSDCT)
.I '$D(ACHSBFUF(ACHSFIN)) S $P(ACHSBFUF(ACHSFIN),U,2)=1,$P(ACHSBFUF(ACHSFIN),U,3)=ACHSDCT
.E S $P(ACHSBFUF(ACHSFIN),U,2)=$P(ACHSBFUF(ACHSFIN),U,2)+1,$P(ACHSBFUF(ACHSFIN),U,3)=$P(ACHSBFUF(ACHSFIN),U,3)+ACHSDCT
.S ACHSBRCT=ACHSBRCT+1,ACHSBDCT=ACHSBDCT+ACHSDCT
S ACHSUFMS=ACHSBRCT_U_ACHSBDCT
Q
FACBC ;TOTAL BY FAC FOR BCBS FILES
S ACHSBRCT=ACHSBRCT+ACHSRCT,ACHSBDCT=ACHSBDCT+ACHSDCT
I '$D(ACHSBFBC($E(ACHSREC,3,8))) S ACHSBFBC($E(ACHSREC,3,8))=ACHSRCT_U_ACHSDCT
E S $P(ACHSBFBC($E(ACHSREC,3,8)),U)=$P(ACHSBFBC($E(ACHSREC,3,8)),U)+ACHSRCT,$P(ACHSBFBC($E(ACHSREC,3,8)),U,2)=$P(ACHSBFBC($E(ACHSREC,3,8)),U,2)+ACHSDCT
S (ACHSRCT,ACHSDCT)=0
S ACHSBFUF(ACHSFIN)=$E(ACHSREC,3,8)_U_0_U_0
S ACHSFIN=0
Q
PRT ; PRINT DATA
W ?5,"Blue Cross Blue Sheild of New Mexico"
S ASUFAC=0 F S ASUFAC=$O(ACHSBFBC(ASUFAC)) Q:ASUFAC'?1N.N D
.Q:$P(ACHSBFBC(ASUFAC),U)=0
.S X=0,X=$O(^AUTTLOC("C",ASUFAC,X)) S ACHSFAC=$P(^DIC(4,X,0),U)
.W !?10,ACHSFAC,?44,$P(ACHSBFBC(ASUFAC),U)
.S X=$P(ACHSBFBC(ASUFAC),U,2)/100,X2=2,X3=16
.D COMMA^%DTC W ?55,X
S X=$P(ACHSBBC,U,2)/100,X2=2,X3=16 D COMMA^%DTC
W !!?5,"Total Finance Records: ",$P(ACHSBBC,U),?35,"Total Dollar Amount: ",X
;
W !!?5,"United Financial Management System"
S ACHS=0 F S ACHS=$O(ACHSBFUF(ACHS)) Q:ACHS="" D
.S ACHSFAC=ACHS
.S ASUFAC=$P(ACHSBFUF(ACHS),U) I ASUFAC'="" S X=0,X=$O(^AUTTLOC("C",ASUFAC,X)) S ACHSFAC=$P(^DIC(4,X,0),U)
.W !?10,ACHSFAC,?44,$P(ACHSBFUF(ACHS),U,2)
.S X=$P(ACHSBFUF(ACHS),U,3)/100,X2=2,X3=16
.D COMMA^%DTC W ?55,X
S X=$P(ACHSUFMS,U,2)/100,X2=2,X3=16 D COMMA^%DTC
W !!?5,"Total Finance Records: ",$P(ACHSUFMS,U),?35,"Total Dollar Amount: ",X
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,"*"
W !?5,"*",?10,$E(DT,4,5),"-",$E(DT,6,7),"-",$E(DT,2,3),?22,"TRANSACTION TOTALS BY FACILITY",?74,"*",!
W ?5,"*",Y,"*",!?5,"* THE DESTINATION OF THESE DATA RECORDS IS: ",?74,"*",!
W ?5,"*",?10,"United Financial Management System and BLUE CROSS/SHIELD OF NM",?74,"*",!
W ?5,"*",Y,"*",!?5,"*",?10,"NAME OF FACILITY",?44,"NUMB TRNS",?60,"DOLLAR AMT",?74,"*",!?5,X,!!
Q
EXIT ;
I $D(IO("S")) S IOP="`"_IOS D ^%ZIS
D ^%ZISC
D HOME^%ZIS U IO
K ACHSBRCT,ACHSBDCT,ACHSRCT,ACHSDCT,ACHSFIN,ACHSREC,ACHSBFBC,ACHSBFUF,ACHSBBC,ACHSUFMS,ACHSFAC,ASUFAC,ACHS
K X,X2,X3,Y
Q
ACHSPCCR ; IHS/ITSC/PMF - CHS AREA SPLITOUT REPORT ;JUL 10, 2008
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**14,21**;JUN 11,2001;Build 43
+2 ;ACHS*3.1*14 11/08/2007 IHS/OIT/FCJ NEW ROUTINE TO PRINT TOTAL RECORDS FOR UFMS AND BCBS
ST ;EP
+1 DO BCBS
DO UFMS
DO HDR1
DO PRT
+2 ;ACHS*3.1*21
SET ^ACHSPCC("PROC")="S"
+3 GOTO EXIT
BCBS ;DATA FOR BCBS
+1 ;achsbrct-batch record count achsbdct=batch dollar amount achsrct-record count achsdct=dollar amount
+2 SET (ACHSBRCT,ACHSBDCT,ACHSRCT,ACHSDCT,ACHSFIN)=0
+3 IF $DATA(^ACHSBCBS)
SET ACHS=""
FOR
SET ACHS=$ORDER(^ACHSBCBS(ACHS))
IF ACHS=""
QUIT
Begin DoDot:1
+4 SET ACHSREC=^ACHSBCBS(ACHS)
+5 IF $EXTRACT(ACHSREC,1,2)="AA"
DO FACBC
QUIT
+6 IF $EXTRACT(ACHSREC,1,2)'="5A"
QUIT
+7 IF $EXTRACT(ACHSREC,1,2)="5A"
+8 SET ACHSRCT=ACHSRCT+1
+9 SET ACHSDCT=$EXTRACT(ACHSREC,69,76)+ACHSDCT
+10 SET ACHSFIN=$EXTRACT(ACHSREC,5,7)
End DoDot:1
+11 SET ACHSBBC=ACHSBRCT_U_ACHSBDCT
+12 QUIT
UFMS ;DATA FOR UFMS
+1 SET (ACHSBRCT,ACHSBDCT,ACHSRCT,ACHSDCT)=0
+2 IF $DATA(^ACHSUFMS)
SET ACHS=0
FOR
SET ACHS=$ORDER(^ACHSUFMS(ACHS))
IF ACHS'?1N.N
QUIT
Begin DoDot:1
+3 SET ACHSREC=^ACHSUFMS(ACHS)
+4 SET ACHSFIN=$EXTRACT(ACHSREC,27,29)
+5 SET ACHSDCT=$EXTRACT(ACHSREC,52,63)
SET Y=$EXTRACT(ACHSREC,11)
+6 SET ACHSDCT=$SELECT(Y=2:"-"_ACHSDCT,1:ACHSDCT)
+7 IF '$DATA(ACHSBFUF(ACHSFIN))
SET $PIECE(ACHSBFUF(ACHSFIN),U,2)=1
SET $PIECE(ACHSBFUF(ACHSFIN),U,3)=ACHSDCT
+8 IF '$TEST
SET $PIECE(ACHSBFUF(ACHSFIN),U,2)=$PIECE(ACHSBFUF(ACHSFIN),U,2)+1
SET $PIECE(ACHSBFUF(ACHSFIN),U,3)=$PIECE(ACHSBFUF(ACHSFIN),U,3)+ACHSDCT
+9 SET ACHSBRCT=ACHSBRCT+1
SET ACHSBDCT=ACHSBDCT+ACHSDCT
End DoDot:1
+10 SET ACHSUFMS=ACHSBRCT_U_ACHSBDCT
+11 QUIT
FACBC ;TOTAL BY FAC FOR BCBS FILES
+1 SET ACHSBRCT=ACHSBRCT+ACHSRCT
SET ACHSBDCT=ACHSBDCT+ACHSDCT
+2 IF '$DATA(ACHSBFBC($EXTRACT(ACHSREC,3,8)))
SET ACHSBFBC($EXTRACT(ACHSREC,3,8))=ACHSRCT_U_ACHSDCT
+3 IF '$TEST
SET $PIECE(ACHSBFBC($EXTRACT(ACHSREC,3,8)),U)=$PIECE(ACHSBFBC($EXTRACT(ACHSREC,3,8)),U)+ACHSRCT
SET $PIECE(ACHSBFBC($EXTRACT(ACHSREC,3,8)),U,2)=$PIECE(ACHSBFBC($EXTRACT(ACHSREC,3,8)),U,2)+ACHSDCT
+4 SET (ACHSRCT,ACHSDCT)=0
+5 SET ACHSBFUF(ACHSFIN)=$EXTRACT(ACHSREC,3,8)_U_0_U_0
+6 SET ACHSFIN=0
+7 QUIT
PRT ; PRINT DATA
+1 WRITE ?5,"Blue Cross Blue Sheild of New Mexico"
+2 SET ASUFAC=0
FOR
SET ASUFAC=$ORDER(ACHSBFBC(ASUFAC))
IF ASUFAC'?1N.N
QUIT
Begin DoDot:1
+3 IF $PIECE(ACHSBFBC(ASUFAC),U)=0
QUIT
+4 SET X=0
SET X=$ORDER(^AUTTLOC("C",ASUFAC,X))
SET ACHSFAC=$PIECE(^DIC(4,X,0),U)
+5 WRITE !?10,ACHSFAC,?44,$PIECE(ACHSBFBC(ASUFAC),U)
+6 SET X=$PIECE(ACHSBFBC(ASUFAC),U,2)/100
SET X2=2
SET X3=16
+7 DO COMMA^%DTC
WRITE ?55,X
End DoDot:1
+8 SET X=$PIECE(ACHSBBC,U,2)/100
SET X2=2
SET X3=16
DO COMMA^%DTC
+9 WRITE !!?5,"Total Finance Records: ",$PIECE(ACHSBBC,U),?35,"Total Dollar Amount: ",X
+10 ;
+11 WRITE !!?5,"United Financial Management System"
+12 SET ACHS=0
FOR
SET ACHS=$ORDER(ACHSBFUF(ACHS))
IF ACHS=""
QUIT
Begin DoDot:1
+13 SET ACHSFAC=ACHS
+14 SET ASUFAC=$PIECE(ACHSBFUF(ACHS),U)
IF ASUFAC'=""
SET X=0
SET X=$ORDER(^AUTTLOC("C",ASUFAC,X))
SET ACHSFAC=$PIECE(^DIC(4,X,0),U)
+15 WRITE !?10,ACHSFAC,?44,$PIECE(ACHSBFUF(ACHS),U,2)
+16 SET X=$PIECE(ACHSBFUF(ACHS),U,3)/100
SET X2=2
SET X3=16
+17 DO COMMA^%DTC
WRITE ?55,X
End DoDot:1
+18 SET X=$PIECE(ACHSUFMS,U,2)/100
SET X2=2
SET X3=16
DO COMMA^%DTC
+19 WRITE !!?5,"Total Finance Records: ",$PIECE(ACHSUFMS,U),?35,"Total Dollar Amount: ",X
+20 QUIT
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,"*"
+4 WRITE !?5,"*",?10,$EXTRACT(DT,4,5),"-",$EXTRACT(DT,6,7),"-",$EXTRACT(DT,2,3),?22,"TRANSACTION TOTALS BY FACILITY",?74,"*",!
+5 WRITE ?5,"*",Y,"*",!?5,"* THE DESTINATION OF THESE DATA RECORDS IS: ",?74,"*",!
+6 WRITE ?5,"*",?10,"United Financial Management System and BLUE CROSS/SHIELD OF NM",?74,"*",!
+7 WRITE ?5,"*",Y,"*",!?5,"*",?10,"NAME OF FACILITY",?44,"NUMB TRNS",?60,"DOLLAR AMT",?74,"*",!?5,X,!!
+8 QUIT
EXIT ;
+1 IF $DATA(IO("S"))
SET IOP="`"_IOS
DO ^%ZIS
+2 DO ^%ZISC
+3 DO HOME^%ZIS
USE IO
+4 KILL ACHSBRCT,ACHSBDCT,ACHSRCT,ACHSDCT,ACHSFIN,ACHSREC,ACHSBFBC,ACHSBFUF,ACHSBBC,ACHSUFMS,ACHSFAC,ASUFAC,ACHS
+5 KILL X,X2,X3,Y
+6 QUIT
