- 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
