119. EPMO Open Source Coordination Office Redaction File Detail Report

Produced by Araxis Merge on 11/9/2018 12:33:57 AM Central Standard Time. See www.araxis.com for information about Merge. This report uses XHTML and CSS2, and is best viewed with a modern standards-compliant browser. For optimum results when printing this report, use landscape orientation and enable printing of background images and colours in your browser.

119.1 Files compared

# Location File Last Modified
1 CPEE_Build9_Sprint27.zip\HAC_CPE_CH CHMKAIS2.m Mon Nov 5 16:40:06 2018 UTC
2 CPEE_Build9_Sprint27.zip\HAC_CPE_CH CHMKAIS2.m Mon Nov 5 17:48:38 2018 UTC

119.2 Comparison summary

Description Between
Files 1 and 2
Text Blocks Lines
Unchanged 2 672
Changed 1 4
Inserted 0 0
Removed 0 0

119.3 Comparison options

Whitespace
Character case Differences in character case are significant
Line endings Differences in line endings (CR and LF characters) are ignored
CR/LF characters Not shown in the comparison detail

119.4 Active regular expressions

No regular expressions were active.

119.5 Comparison detail

  1   CHMKAIS2 ; HAC/AHJ;$$  CHAMPVA S AVINGS FRO M AI OUTPU T TO SPREA DSHEET
  2    ;;1.0;CHA MPVA SYSTE M;;JULY 4,  1990;Buil d 1
  3    ;
  4    ;MTN01347 1 JSE - 10 /28/11 FIX  UNDEF ERR OR FMJUL+5
  5    ;
  6   ZSET S:'$D (DUZ) DUZ= 1,DUZ(0)=" " I '$D(DT ) S %DT="" ,X="T" D ^ %DT S DT=Y
  7    S:'$D(IOZ FO) IOZFO= "^^" S:'$D (IOZBK) IO ZBK="^" S: '$D(DTIME)  DTIME=60
  8    I '$D(IOZ ) S %ZIS=" N" S IOP=" HOME" D HO ME^%ZIS S  IOZ=IO,IOZ L=IOSL,IOZ W=IOM,IOZF =IOF,IOZT= IOST,IOZN= ION,IOZS=I OS
  9    S Y=0
  10    ;
  11   A4 ;Start  Printer he re
  12    D START^C HMKAIS2,EN D^CHMKAIS2
  13    Q
  14   START ; Y2 K Modified  start log ic to hand le new PDI  format
  15    I CHPGTYP ="1" S HDT ITLE="CHAM PVA AI Sav ings"
  16    ;I CHPGTY P="CHF" S  HDTITLE="C HAMPVA For eign AI Sa vings"
  17    ;I CHPGTY P="FMP" S  HDTITLE="F oreign Med ical Progr am AI Savi ngs"
  18    ;I CHPGTY P="PGW" S  HDTITLE="P ersian Gul f Program  AI Savings "
  19    I CHPGTYP ="6" S HDT ITLE="Spin a Bifida A I Savings"
  20    I CHPGTYP ="7" S HDT ITLE="Chil dren of Wo men Vietna m Vets AI  Savings"
  21    I CHPGTYP ="A" S HDT ITLE="ALL  AI Savings "
  22    S X=CHDT  D DTPRT S  CHDTP1=Y S  X=CHDT2 D  DTPRT S C HDTP2=Y
  23    S HSTRDAT =$E(CHDT,4 ,5)_$E(CHD T,6,7)_$E( CHDT,2,3)
  24    S HENDDAT =$E(CHDT2, 4,5)_$E(CH DT2,6,7)_$ E(CHDT2,2, 3)
  25    X ^%ZOSF( "UCI") S C HUCI=$P(Y, ",",1)
  26    ;S FIO="H ACFS3"" DNS     decnet HAC dec741!"": :D:[FS3BIG .AI-SAVING S-REPORT]A I-SAVINGS- REPORT-"_H STRDAT_"-" _ HENDDAT_ ".XLS"
  27    I CHUCI=" HAC" S FIO ="HACFS3"" DNS     decnet HAC dec741!"": :D:[FS3BIG .AI-SAVING S-REPORT]A I-SAVINGS- REPORT-"_H DTITLE_"-" _HSTRDAT_" -"_ HENDDA T_".XLS"
  28    I CHUCI'= "HAC" S FI O="HAC_HFS $:[DSMMANA G.CHAMPVA] "_CHUCI_"_ "_HDTITLE_ "-"_HSTRDA T_"-"_ HEN DDAT_".DAT "
  29    O FIO C F IO:"D"
  30    O FIO:"NW V"
  31    S T=$C(9)
  32    S CNT=0
  33    S STOPMO= 0
  34    S PCITISW =0
  35    S T=$C(9)
  36    S SW=0
  37    S TOT1=0, TOT2=0,TOT 3=0
  38    S CNT=0
  39    D NOW^%DT C S RUNTIM E=%
  40    S TODAY=$ E(RUNTIME, 1,7)
  41    S CHTOT=0 ,CHBILL=0, CHCLAIM=0, CT=0,PAID= 0
  42    S X1=$$FM JUL(CHDT)
  43    S X2=$$FM JUL(CHDT2)
  44    ;NEXT 2 L INES NEW S TART AND E ND DATES
  45    ;S X1=$$F MJUL(STRDT )
  46    ;S X2=$$F MJUL(ENDDT )
  47    ; 13 Digi t PDI Loop
  48    I CHDT<30 00000 D                              
  49    .S PDI=X1 _"00000000 "
  50    .S PDI2=X 2_"9999999 9"
  51    .S:CHDT2> 3000000 PD I2=9999999 999999
  52    .D START2
  53    .Q
  54    ; 15 digi t PDI Loop
  55    S PDI=$$C EN2^CHMFPD I2(X1)_X1_ "00000000"
  56    ;S PDI=20 0700503017 996
  57    S PDI2=$$ CEN2^CHMFP DI2(X2)_X2 _"99999999 "
  58    D START2
  59    ;
  60    D HEAD
  61    D PRINT
  62    K ^CHMZHO LD($J,"AIA I")
  63    Q
  64    ;
  65   START2 F   S PDI=$O(^ CHMPAY("C" ,PDI)) Q:( PDI>PDI2)! 'PDI  S CI =0 F  S CI =$O(^CHMPA Y("C",PDI, CI)) Q:'CI   D
  66    .Q:'$D(^C HMPAY(CI,0 ))  S REC0 =^(0)
  67    .Q:$P(REC 0,"^",2)=1   Q:$P(REC 0,"^",2)=7  ;QUIT IF  STATUS IN  PROGRESS,A DMIN SUSPE NSE
  68    .Q:$P(REC 0,"^",2)=1 0 ;QUIT IF  STATUS DE LETED
  69    .Q:$P(REC 0,"^",7)'= 2 ;QUIT IF  TYPE NOT  OUTPATIENT
  70    .;NEED EX TERNAL CLA IM NUMBER  HERE CI=IN TERNAL NUM BER  CII=E XTERNAL NU MBER
  71    .S CII=$P (REC0,"^", 1) ;AHJ
  72    .;    NEX T LINE FIN D EACH CLA IM PROGRAM  TYPE AHJ
  73    .;Q:'$D(^ CHMINDEX(" B",CII))   S CLMPT=0, CLMPT=$O(^ CHMINDEX(" B",CII,CLM PT)) S IND X0=^CHMIND EX(CLMPT,0 ) S PROGTY PE=$P(INDX 0,"^",2) Q :PROGTYPE= "" ;AHJ
  74    .S X1=CI  D PROGTYP^ CHFCD001 S  PROGTYPE= CHPGPT
  75    .;NEXT LI NE MATCH C LAIM PROGR AM TYPE TO  REQUESTED  PROGRAM
  76    .;I CHPGT YP'="A" I  CHPGTYP'=" CIT" Q:PRO GTYPE'=CHP GTYP ; AHJ  SELECT PR OGRAM TYPE  HERE
  77    .I CHPGTY P=1 I PROG TYPE'=1 I  PROGTYPE'= 2 Q  ;QUIT  IF NOT CV A OR CVAF
  78    .I CHPGTY P=6 Q:PROG TYPE'=CHPG TYP
  79    .I CHPGTY P=7 Q:PROG TYPE'=CHPG TYP
  80    .;
  81    .;NEXT LI NE FIND CI TI CLAIMS
  82    .I CHPGTY P="CIT" I  $E(PDI,8,9 )="04" Q 
  83    .;
  84    .;NEXT 2  LINES PDI  JULIAN CON VERT TO DA TE MONTH
  85    .S CHPDID T=$$PDIJUL FM^CHMFPDI 2(PDI)
  86    .S MO=$E( CHPDIDT,4, 5)
  87    .S:($P(RE C0,"^",7)= 2)!($P(REC 0,"^",7)=6 )!($P(REC0 ,"^",7)=5)  RULE="RUL E-PROC" ;T YPE =OUTPA TIENT, DEN TAL OR TRA VEL  
  88    .S:$P(REC 0,"^",7)=3  RULE="RUL E=PHARM" ; TYPE=PHARM ACY
  89    .Q:'$D(^C HMPAY(CI,R ULE)) ;ONL Y RULE="RU LE-PROC"
  90    .S J=0,PT OT=0,PBILL =0 F  S J= $O(^CHMPAY (CI,RULE,J )) Q:'J  D
  91    ..Q:$P(^C HMPAY(CI,R ULE,J,0)," ^",1)'=0 ; COVERAGE C ODE = REJE CT
  92    ..S REAS= $P(^CHMPAY (CI,RULE,J ,0),"^",2)  Q:REAS>99 9  Q:REAS= "" ;GET AI  REASON  ( CHMDIC(741 002.22
  93    ..I '$D(^ CHMZHOLD($ J,"AIAI"," TMP-MATCH" ,REAS)) Q  ; OUT FOR  TEST ONLY
  94    ..S STFL= 0
  95    ..I $D(^C HMPAY(CI," RULE-QA"))  S QJ=0 F   S QJ=$O(^ CHMPAY(CI, "RULE-QA", QJ)) Q:'QJ   D   ;
  96    ...Q:$P(^ (QJ,0),"^" ,3)'=J
  97    ...S:$P(^ (0),"^",5) '="" STFL= 1
  98    ..Q:STFL   
  99    ..I ($P(R EC0,"^",7) =2)!($P(RE C0,"^",7)= 6) D ^CHKC CSA2 D   ; MUST BE OU TPATIENT O R DENTAL
  100    ...S:CHMP F>$P(^CHMP AY(CI,"OPT -PROC",J,0 ),"^",2) C HMPF=$P(^C HMPAY(CI," OPT-PROC", J,0),"^",2 )
  101    ...S:CHMP F=0 CHMPF= $P(^CHMPAY (CI,"OPT-P ROC",J,0), "^",2)
  102    ..S CHCLA IM=CHCLAIM +1
  103    ..S:($P(R EC0,"^",7) =2)!($P(RE C0,"^",7)= 6) PBILL=P BILL+$P(^C HMPAY(CI," OPT-PROC", J,0),"^",2 ),PTOT=PTO T+CHMPF,BI LL=$P(^CHM PAY(CI,"OP T-PROC",J, 0),"^",2)
  104    ..S:$P(RE C0,"^",7)= 3 PBILL=PB ILL+$P(^CH MPAY(CI,"P HARM",J,0) ,"^",4),PT OT=PTOT+$P (^CHMPAY(C I,"PHARM", J,0),"^",4 ),(CHMPF,B ILL)=$P(^C HMPAY(CI," PHARM",J,0 ),"^",4)
  105    ..S:$P(RE C0,"^",7)= 4 PBILL=PB ILL+$P(^CH MPAY(CI,"D ME-SUPPLY" ,J,0),"^", 2),PTOT=PT OT+$P(^CHM PAY(CI,"DM E-SUPPLY", J,0),"^",2 ),(CHMPF,B ILL)=$P(^C HMPAY(CI," DME-SUPPLY ",J,0),"^" ,2)
  106    ..S:$P(RE C0,"^",7)= 5 PBILL=PB ILL+$P(^CH MPAY(CI,"D EN-PROC",J ,0),"^",2) ,PTOT=PTOT +$P(^CHMPA Y(CI,"DEN- PROC",J,0) ,"^",2),(C HMPF,BILL) =$P(^CHMPA Y(CI,"DEN- PROC",J,0) ,"^",2)
  107    ..S:'$D(^ CHMZHOLD($ J,"AIAI"," TEST",REAS ,1)) ^CHMZ HOLD($J,"A IAI","TEST ",REAS,1)= "0^0^0^0^0 ^0^0^0^0^0 ^0^0^" ;AH J
  108    ..S:'$D(^ CHMZHOLD($ J,"AIAI"," TEST",REAS ,2)) ^CHMZ HOLD($J,"A IAI","TEST ",REAS,2)= "0^0^0^0^0 ^0^0^0^0^0 ^0^0^" ;AH J
  109    ..S:'$D(^ CHMZHOLD($ J,"AIAI"," TEST",REAS ,3)) ^CHMZ HOLD($J,"A IAI","TEST ",REAS,3)= "0^0^0^0^0 ^0^0^0^0^0 ^0^0^" ;AH J
  110    ..S:'$D(^ CHMZHOLD($ J,"AIAI"," AAAA",RUNT IME)) ^CHM ZHOLD($J," AIAI","AAA A",RUNTIME )="0^0^0^0 ^0^0^0^0^0 ^0^0^0^" ; AHJ  TOTAL S FOR COUN T PROC
  111    ..S:'$D(^ CHMZHOLD($ J,"AIAI"," BBBB",RUNT IME)) ^CHM ZHOLD($J," AIAI","BBB B",RUNTIME )="0^0^0^0 ^0^0^0^0^0 ^0^0^0^" ; AHJ TOTALS  FOR BILLE D CHARGES
  112    ..S:'$D(^ CHMZHOLD($ J,"AIAI"," ZZZZ",RUNT IME)) ^CHM ZHOLD($J," AIAI","ZZZ Z",RUNTIME )="0^0^0^0 ^0^0^0^0^0 ^0^0^0^" ; AHJ TOTALS  FOR ALLOW ABLE SAVIN GS
  113    ..S $P(^C HMZHOLD($J ,"AIAI","T EST",REAS, 1),"^",MO) =$P(^CHMZH OLD($J,"AI AI","TEST" ,REAS,1)," ^",MO)+1 ; AHJ Allow  Charges
  114    ..S $P(^C HMZHOLD($J ,"AIAI","T EST",REAS, 2),"^",MO) =$P(^CHMZH OLD($J,"AI AI","TEST" ,REAS,2)," ^",MO)+BIL L ;AHJ Bil led Charge s
  115    ..S $P(^C HMZHOLD($J ,"AIAI","T EST",REAS, 3),"^",MO) =$P(^CHMZH OLD($J,"AI AI","TEST" ,REAS,3)," ^",MO)+CHM PF ;AHJ Co unt proced ures
  116    ..S $P(^C HMZHOLD($J ,"AIAI","A AAA",RUNTI ME),"^",MO )=$P(^CHMZ HOLD($J,"A IAI","AAAA ",RUNTIME) ,"^",MO)+1  ;AHJ GRAN D TOTALS C OUNT PROC
  117    ..S $P(^C HMZHOLD($J ,"AIAI","B BBB",RUNTI ME),"^",MO )=$P(^CHMZ HOLD($J,"A IAI","BBBB ",RUNTIME) ,"^",MO)+B ILL ;AHJ G RAND TOT B ILLED CHAR GES
  118    ..S $P(^C HMZHOLD($J ,"AIAI","Z ZZZ",RUNTI ME),"^",MO )=$P(^CHMZ HOLD($J,"A IAI","ZZZZ ",RUNTIME) ,"^",MO)+C HMPF ;AHJ  GRAND TOT  ALLOW SAVI NGS
  119    .S CHTOT= CHTOT+PTOT ,CHBILL=CH BILL+PBILL
  120    .I PTOT'= 0 S CT=CT+ 1 S:$D(^CH MPAY(CI,1) ) PAID=PAI D+$P(^CHMP AY(CI,1)," ^",1)
  121    .Q
  122    Q
  123     ;
  124   PRINT ;
  125    S T=$C(9)
  126    D FIXMO
  127    S ATIME=0 ,TOT1=0
  128    G:'$D(^CH MZHOLD($J, "AIAI","AA AA")) STOP IT
  129    S ATIME=$ O(^CHMZHOL D($J,"AIAI ","AAAA",A TIME))
  130    S TOT1=^C HMZHOLD($J ,"AIAI","A AAA",ATIME )
  131    ;
  132    ;roll tot als for to tal denied  proc
  133    F X=10:1: 12 S J=X S  J=J-9 S R OLL(J)=$P( TOT1,"^",X )
  134    F X=1:1:9  S J=X+3 S  ROLL(J)=$ P(TOT1,"^" ,X)
  135    F X=2:1:S TOPMO S J= X-1 S ROLL (X)=ROLL(X )+ROLL(J)
  136    D FIXMO
  137    ;W !,"EOB "_T_"Total  Denied Pr oc"_T S J= 25 F X=1:1 :STOPMO U  FIO W ?J,$ J(ROLL(X), 8,0)_T S J =J+9
  138    F X=1:1:1 2 S $P(LIN E,T,(X))=$ J(ROLL(X), 8,0)
  139    S TOGETHE R="EOB"_T_ "Total Den ied Proc"_ T_LINE
  140    U FIO W T OGETHER,!
  141    ;
  142    ;original  code with  separate  month tota ls
  143    ;W !,"EOB " W ?5,"To tal Denied  Proc" S J =25 F X=10 :1:12 W ?J ,$J($P(TOT 1,"^",X),8 ,0) S J=J+ 9
  144    ;S J=52 F  X=1:1:9 W  ?J,$J($P( TOT1,"^",X ),8) S J=J +9
  145    ;
  146    S BTIME=0 ,TOT2=0
  147    S BTIME=$ O(^CHMZHOL D($J,"AIAI ","BBBB",B TIME))
  148    S TOT2=^C HMZHOLD($J ,"AIAI","B BBB",BTIME )
  149    ;
  150    ;roll tot als for to t Denied B ill Crg
  151    F X=10:1: 12 S J=X S  J=J-9 S R OLL1(J)=$P (TOT2,"^", X)
  152    F X=1:1:9  S J=X+3 S  ROLL1(J)= $P(TOT2,"^ ",X)
  153    F X=2:1:S TOPMO S J= X-1 S ROLL 1(X)=ROLL1 (X)+ROLL1( J)
  154    D FIXMO
  155    ;U FIO W  !,"Reas"_T  U FIO W ? 5,"Tot Den ied Bill C rg"_T S J= 25 F X=1:1 :STOPMO U  FIO W ?J,$ J(ROLL1(X) ,8,0)_T S  J=J+9 ;
  156    F X=1:1:1 2 S $P(LIN E,T,(X))=$ J(ROLL1(X) ,8,0)
  157    S TOGETHE R1="Reas"_ T_"Total B ill Crg"_T _LINE
  158    U FIO W T OGETHER1,! !
  159    ;
  160    ;original  code with  separate  month tota ls
  161    ;W !,"Rea s " W ?5," Tot Denied  Bill Crg"  S J=25 F  X=10:1:12  W ?J,$J($P (TOT2,"^", X),8,0) S  J=J+9
  162    ;S J=52 F  X=1:1:9 W  ?J,$J($P( TOT2,"^",X ),8,0) S J =J+9
  163   DETAIL ;
  164    S REAS=0
  165   T1 ;
  166    S REAS=$O (^CHMZHOLD ($J,"AIAI" ,"TEST",RE AS)) I REA S="" G END TOT
  167    S LEV=0
  168   T2 ;
  169    S LEV=$O( ^CHMZHOLD( $J,"AIAI", "TEST",REA S,LEV)) I  LEV="" G T 1
  170    S DET1=^C HMZHOLD($J ,"AIAI","T EST",REAS, LEV)
  171    ;
  172    ;roll tot als for pr ocedures d enied
  173    I LEV=1 F  X=10:1:12  S J=X S J =J-9 S ROL L3(J)=$P(D ET1,"^",X)
  174    I LEV=1 F  X=1:1:9 S  J=X+3 S R OLL3(J)=$P (DET1,"^", X)
  175    I LEV=1 F  X=2:1:STO PMO S J=X- 1 S ROLL3( X)=ROLL3(X )+ROLL3(J)
  176    D FIXMO
  177    ;I LEV=1  U FIO W ?5 ,"Procedur es Denied" _T S J=25  F X=1:1:ST OPMO U FIO  W ?J,$J(R OLL3(X),8, 0)_T S J=J +9
  178    I LEV=1 F  X=1:1:12  S $P(LINE, T,(X))=$J( ROLL3(X),8 ,0)
  179    I LEV=1 S  TOGETHER3 =T_"Proced ures Denie d"_T_LINE
  180    I LEV=1 U  FIO W TOG ETHER3,!
  181    ;
  182    ;Original  code with  separate  month tota ls
  183    ;I LEV=1  W !!
  184    ;I LEV=1  W ?5,"Proc edures Den ied" S J=2 5 F X=10:1 :12 W ?J,$ J($P(DET1, "^",X),8,0 ) S J=J+9
  185    ;I LEV=1  S J=52 F X =1:1:9 W ? J,$J($P(DE T1,"^",X), 8) S J=J+9
  186    ;
  187    ;Roll Tot als for De nied Bill  Charges
  188    I LEV=2 F  X=10:1:12  S J=X S J =J-9 S ROL L4(J)=$P(D ET1,"^",X)
  189    I LEV=2 F  X=1:1:9 S  J=X+3 S R OLL4(J)=$P (DET1,"^", X)
  190    I LEV=2 F  X=2:1:STO PMO S J=X- 1 S ROLL4( X)=ROLL4(X )+ROLL4(J)
  191    ;I LEV=2  U FIO W !!
  192    D FIXMO
  193    ;I LEV=2  U FIO W !, REAS_T W ? 5,"Denied  Bill Charg es"_T S J= 25 F X=1:1 :STOPMO U  FIO W ?J,$ J(ROLL4(X) ,8,0)_T S  J=J+9
  194    I LEV=2 F  X=1:1:12  S $P(LINE, T,(X))=$J( ROLL4(X),8 ,0)
  195    I LEV=2 S  TOGETHER4 =REAS_T_"D enied Bill  Charges"_ T_LINE
  196    I LEV=2 U  FIO W TOG ETHER4,!
  197    ; 
  198    ;Original  code with  separate  month tota ls
  199    ;I LEV=2   W !,REAS  W ?5,"Deni ed Bill Ch arges" S J =25 F X=10 :1:12 W ?J ,$J($P(DET 1,"^",X),8 ,0) S J=J+ 9
  200    ;I LEV=2   S J=52 F  X=1:1:9 W  ?J,$J($P(D ET1,"^",X) ,8,0) S J= J+9
  201    ;
  202    ;roll tot als for al lowable sa vings
  203    I LEV=3 F  X=10:1:12  S J=X S J =J-9 S ROL L5(J)=$P(D ET1,"^",X)
  204    I LEV=3 F  X=1:1:9 S  J=X+3 S R OLL5(J)=$P (DET1,"^", X)
  205    I LEV=3 F  X=2:1:STO PMO S J=X- 1 S ROLL5( X)=ROLL5(X )+ROLL5(J)
  206    ;I LEV=3  U FIO W !!
  207    D FIXMO
  208    ;I LEV=3  U FIO W !, " "_T W ?5 ,"Allowabl e Savings" _T S J=25  F X=1:1:ST OPMO U FIO  W ?J,$J(R OLL5(X),8, 0)_T S J=J +9
  209    I LEV=3 F  X=1:1:12  S $P(LINE, T,(X))=$J( ROLL5(X),8 ,0)
  210    I LEV=3 S  TOGETHER5 =T_"Allowa ble Saving s"_T_LINE
  211    I LEV=3 U  FIO W TOG ETHER5,!!
  212    ;
  213    ;original  code sepa rate month  totals
  214    ;I LEV=3  W !," " W  ?5,"Allowa ble Saving s:" S J=25  F X=10:1: 12 W ?J,$J ($P(DET1," ^",X),8,0)  S J=J+9
  215    ;I LEV=3  S J=52 F X =1:1:9 W ? J,$J($P(DE T1,"^",X), 8,0) S J=J +9
  216    G T2
  217    Q
  218   ENDTOT ; 
  219    S ZTIME=0 ,TOT3=0
  220    S ZTIME=$ O(^CHMZHOL D($J,"AIAI ","ZZZZ",Z TIME))
  221    S TOT3=^C HMZHOLD($J ,"AIAI","Z ZZZ",ZTIME )
  222    U FIO W T _"Total CH AMPVA",!
  223    ;
  224    ;roll  to tals for g rand total  allowable  savings
  225    F X=10:1: 12 S J=X S  J=J-9 S R OLL6(J)=$P (TOT3,"^", X)
  226    F X=1:1:9  S J=X+3 S  ROLL6(J)= $P(TOT3,"^ ",X)
  227    F X=2:1:S TOPMO S J= X-1 S ROLL 6(X)=ROLL6 (X)+ROLL6( J)
  228    D FIXMO
  229    ;U FIO W  !,?5,"Allo wable Savi ngs"_T S J =25 F X=1: 1:STOPMO U  FIO W ?J, $J(ROLL6(X ),8,0)_T S  J=J+9
  230    F X=1:1:1 2 S $P(LIN E,T,(X))=$ J(ROLL6(X) ,8,0)
  231    S TOGETHE R6=T_"Allo wable Savi ngs"_T_LIN E
  232    U FIO W T OGETHER6
  233    ;
  234    ;original  code sepa rate month  totals
  235    ;W !,?5," Allowable  Savings:"  S J=25 F X =10:1:12 W  ?J,$J($P( TOT3,"^",X ),8,0) S J =J+9
  236    ;S J=52 F  X=1:1:9 W  ?J,$J($P( TOT3,"^",X ),8,0) S J =J+9
  237    ;
  238    S REASON= 0
  239    U FIO W !
  240   E1 ;
  241    S REASON= $O(^CHMZHO LD($J,"AIA I","TMP-MA TCH",REASO N)) I REAS ON="" G EN D
  242    S REASDIS =$P(^CHMDI C(741002.2 2,REASON,0 ),"^",2)
  243    S TOGETHE R7="#"_REA SON_T_REAS DIS
  244    ;U FIO W  !,"#",REAS ON_T,?5,RE ASDIS
  245    U FIO W ! ,TOGETHER7
  246    G E1
  247    Q
  248   QUEUEIT  ;
  249    ;W !,"HER E IS THE P RINT STUFF "
  250    S ZTDTH=$ H
  251    S ZTRTN=" A4^CHMKAIS 1"
  252    S ZTDESC= "AI REPORT "
  253    S ZTSAVE( "*")="",ZT SAVE("^CHM ZHOLD($J," "AIAI"",") =""
  254    D ^%ZTLOA D
  255    W !!?5,"R eport Queu ed!"
  256    D HOME^%Z IS Q
  257    Q
  258   END ;
  259    X ^%ZOSF( "UCI") S C HUCI=$P(Y, ",",1)
  260    I CHUCI=" HAC" S X=$ ZF(-1,"SUB MIT HAC_HF S$:[SCR.TE MP_FILES]R EC_COPY.CO M/PARAM=(" _FIO_")")
  261    C FIO
  262    K X,X12,Y ,TOT,TOT2, TOT3,TOGET HER7,TOGET HER6,TOGET HER5,TOGET HER4,TOGET HER3
  263    K TOGETHE R2,TOGETHE R1,TOGETHE R,T,T1,T2, ROLL6,ROLL 5,ROLL4,RO LL3,ROLL1, RULE
  264    K RUNTIME ,ROLL,MCHD T,MCHDT2,M O,MSYS,NM, PAID,PBILL ,PCITISW,P DI,PDI2,PG ,POP,PROGS W
  265    K PROGTYP E,PTOT,QJ, REAS,REASD IS,REASON, QJ,REC0,RM SDF,TOT1,X 1,X2,TS,YR ,TODAY,TIM E,TEST
  266    K XTS,SW, STOPMO,STF L,PF,M,LIN E,LEV,K2,J ,CT,DET1,E NDMO,FN,H, HDTITLE,HE NDDAT,HSTR DAT
  267    K I,INDX0 ,CHMPF,CHM POS,CHMRDT ,CHMREC,CH MRSD,CHMSP ,CHMSPC,CH PDIDT,CHPG PT,CHPGTYP
  268    K SDUZ,CH UCI,CHUCIP T,CHX,CI,C II,CNT,BIL L,BTIME,CH ADOC,CHBIL L,CHCLS,CH CMDT,CHDT, CHDT2
  269    K CHEXT,C HFIO,CHLDT ,CHLNM,CHL OC,CHMDOS, CHMFAC,CHM FQUE,CHMMD P,CHPNM,CH SYS,CHTOT
  270    K CHADOS, CHCLAIM,CH DTP1,CHDTP 2,CHTYP,AT IME
  271    Q
  272   FIXMO ;
  273    S ENDMO=$ E(CHDT2,4, 5)
  274    I ENDMO=1 0 S STOPMO =1
  275    I ENDMO=1 1 S STOPMO =2
  276    I ENDMO=1 2 S STOPMO =3
  277    I ENDMO=" 01" S STOP MO=4
  278    I ENDMO=" 02" S STOP MO=5
  279    I ENDMO=" 03" S STOP MO=6
  280    I ENDMO=" 04" S STOP MO=7
  281    I ENDMO=" 05" S STOP MO=8
  282    I ENDMO=" 06" S STOP MO=9
  283    I ENDMO=" 07" S STOP MO=10
  284    I ENDMO=" 08" S STOP MO=11
  285    I ENDMO=" 09" S STOP MO=12
  286    Q
  287   HEAD ;  
  288    S X=DT D  DTPRT S DA TE=Y,PG=1, X=$P($H,", ",2),H=X\3 600,M=X#36 00\60
  289    S:M<10 M= 0_M S:H<10  H=0_H S T IME=H_M
  290    U FIO W D UZ,"                             HEALTH ADM INISTRATIO N CENTER " ,!
  291    S X=DT D  DTPRT S DA TE=Y
  292    S X=$P($H ,",",2),H= X\3600,M=X #3600\60
  293    ;S:M<10 M =0_M S:H<1 0 H=0_H S  TIME=H_MHE AD
  294    ;
  295    I CHPGTYP ="1" S HDT ITLE="CHAM PVA AI Sav ings"
  296    ;I CHPGTY P="CHF" S  HDTITLE="C HAMPVA For eign AI Sa vings"
  297    ;I CHPGTY P="FMP" S  HDTITLE="F oreign Med ical Progr am AI Savi ngs"
  298    ;I CHPGTY P="PGW" S  HDTITLE="P ersian Gul f Program  AI Savings "
  299    I CHPGTYP ="6" S HDT ITLE="Spin a Bifida A I Savings"
  300    I CHPGTYP ="7" S HDT ITLE="Chil dren of Wo men Vietna m Vets AI  Savings"
  301    I CHPGTYP ="A" S HDT ITLE="ALL  AI Savings "
  302    ;
  303    ;W !,?28, "(Not incl uding Clai mCheck)"
  304    ;W !!,?80 -$L(DATE)/ 2,DATE
  305    S X=CHDT  D DTPRT S  CHDTP1=Y S  X=CHDT2 D  DTPRT S C HDTP2=Y 
  306    U FIO W D ATE,"                            AI SAVINGS  REPORT",!
  307    ;
  308    S T1=$E(T IME,1,2)
  309    S T2=$E(T IME,3,4)
  310    S TIME=T1 _":"_T2
  311    U FIO W T IME,"                     Report  for : "_H DTITLE_" f rom ",CHDT P1_" - "_C HDTP2,!
  312    U FIO W !
  313    U FIO W T _T_"Octobe r"_T_"Nove mber"_T_"D ecember"_T _"January" _T_"Februa ry"_T_"Mar ch"_T_"Apr il"_T_"May "_T_"June" _T_"July"_ T_"August" _T_"Septem ber"_T,!
  314    Q
  315    ;      
  316   DTPRT S Y= "" Q:X'?7N   S Y=$E(X ,1,3)+1700 ,%M=+$E(X, 4,5),%D=+$ E(X,6,7)
  317    I %M S:%D  Y=$E(" ", $L(%D))_%D _", "_Y S  Y=$P($P($T (JAN),";;" ,2)," ",%M )_" "_Y
  318    Q
  319   JAN ;;JAN  FEB MAR AP R MAY JUN  JUL AUG SE P OCT NOV  DEC
  320   SBRS R Y:$ S($D(DTIME ):DTIME,1: 60)
  321    I '$T W * 7 R Y:5 G  SBRS:Y="."  S:'$T Y=I OZFO
  322   SBRS1 K DF OUT,DUOUT, DQOUT S:'$ D(IOZFO) I OZFO="^^"  S:'$D(IOZB K) IOZBK=" ^"
  323    I IOZFO=Y  W:$D(IOZF ) # S (DFO UT,Y)="" Q
  324    S:Y=IOZBK  (DUOUT,Y) ="" S:Y?1" ?".E!(Y["^ ") (DQOUT, Y)=""
  325   FMJUL(FDT)  ;CONVERT  FM DATE TO  JULIAN DA TE
  326    N D1,D2,D 3
  327    I '$D(FDT ) S FDT=DT
  328    S X=$E(FD T,1,3)_"00 00" D H^%D TC S D2=%H
  329    S X=FDT D  H^%DTC S  D1=%H
  330    ;MTN01347 1 JSE - 10 /28/11 FIX  UNDEF ERR OR FMJUL+5
  331    ;S D3=D1- D2+1 S:D3< 100 D3="0" _D3 S:D3<1 0 D3="0"_D
  332    S D3=D1-D 2+1 S:D3<1 00 D3="0"_ D3 S:D3<10  D3="0"_D3
  333    S D3=$E(F DT,2,3)_D3
  334    Q D3
  335    Q
  336   STOPIT ;
  337     W !,"NO  DATA FOUND  FOR THIS  SEARCH!!!"  Q
  338     Q