31. EPMO Open Source Coordination Office Redaction File Detail Report

Produced by Araxis Merge on 12/7/2017 6:28:36 PM Eastern 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.

31.1 Files compared

# Location File Last Modified
1 OSCIF_CPEE_Sprint_1 and 2.zip\Build_4_Sprint_2\CPE005-095 PPR Report Total Payment Current PDI CHMF351U Developer Form.docx Thu Dec 7 15:13:28 2017 UTC
2 OSCIF_CPEE_Sprint_1 and 2.zip\Build_4_Sprint_2\CPE005-095 PPR Report Total Payment Current PDI CHMF351U Developer Form.docx Thu Dec 7 23:04:34 2017 UTC

31.2 Comparison summary

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

31.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

31.4 Active regular expressions

No regular expressions were active.

31.5 Comparison detail

  1   Routine Na me:  _____ ____CHMF35 1U_
  2   Developer  Name(s):   ______Cind y Stiles__ ______
  3   Associated  User Stor y/Stories:     ______ CPE005-069 __
  4   Current ve rsion (Por tions that  are added  to, modif ied or del eted [Matc h up with  New Versio n section)
  5  
  6   CHMF351U ; DEH/DEN;UT ILITY FILE  FOR PPR P RINT ;05/2 7/99 10:47  AM ;;1.0; CHAMPVA SY STEM;;JULY  4, 1990;B uild 10 ;; V1.0;; ;CP TS #12621*  (RLC), #1 3782* (RLC ) , 16785  (AEB) ;THI S ROUTINE  CREATED TO  DOWNSIZE  CHMF351P ;  DEV7820 E W 3/17/11  Add line l evel TOTAL  data and  notes ;DEV 019388 11/ 5/13 DGC -  Change in  INP proce ssing ;BOT   ; ;----- - DEV7820  EW 8/9/11  START I $P (X,"^",3)= "Inpatient " D .S SOR T="",CHSOH IPDT="",CH SOHIPRT="" ,CHSDEDUCT T="",CHSME DPDT="",CH SOHIADT="" ,CHSOHIPBT ="",CHSCSA T="",CHSPA YAT="",SPB IF=0,TCHAR GE="",TALL OW="" ;DGC  1/13/14 B UG019388 . S CHCLNP=$ O(@(GLPAY_ """B"",CHC LN,0)")) Q :'CHCLNP . I $D(@(GLP AY_"CHCLNP ,""INP"")" )) D ;DGC  11/5/13 DE V019388 .. S:$P(@(GLP AY_"CHCLNP ,""INP"")" ),"^",10)' ="" TCHARG E=$J($FN($ P(X,"^",8) ,",",2),11 )_"A" ;DGC  11/5/13 D EV019388 . .S:$P(@(GL PAY_"CHCLN P,""INP"") "),"^",10) ="" TCHARG E=$J($FN($ P(X,"^",8) ,",",2),11 ) ;DGC 11/ 5/13 DEV01 9388 E  S  TCHARGE=$J ($FN(TCHAR GE,",",2), 11) I $P(X ,"^",3)'=" Inpatient"  W !,"---- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- -" ;DGC 1/ 13/14 BUG0 19388 E  W  !! ;DGC 1 /13/14 BUG 019388 ;IF  NO SLA DA TA USE CLA IM S CHTPL ="" I CHSO HIPDT'=""  S CHSOHIPD T=$J($FN(C HSOHIPDT," ,",2),11)  I (CHSOHIP DT="")&($P (X,"^",12) '="") S CH SOHIPDT=$J ($FN($P(X, "^",12),", ",2),11) I  CHSOHIPRT '="" S CHS OHIPRT=$J( $FN(CHSOHI PRT,",",2) ,11) I (CH SOHIPRT="" )&($P(X,"^ ",24)'="")  S CHSOHIP RT=$J($FN( $P(X,"^",2 4),",",2), 11) I CHSO HIADT'=""  S CHSOHIAD T=$J($FN(C HSOHIADT," ,",2),11)  I (CHSOHIA DT="")&($P (X,"^",27) '="") S CH SOHIADT=$J ($FN($P(X, "^",27),", ",2),11) ; MTN013163F  EW BUG BE N39 6/29/1 2 I CHSOHI PBT'="" S  CHSOHIPBT= $J($FN(CHS OHIPBT,"," ,2),11) I  (CHSOHIPBT ="")&($P(X ,"^",28)'= "") S CHSO HIPBT=$J($ FN($P(X,"^ ",28),",", 2),11) ;MT N013163F E W BUG BEN3 9 6/29/12  I CHSDEDUC TT'="" S C HSDEDUCTT= $J($FN(CHS DEDUCTT,", ",2),11) I  (CHSDEDUC TT="")&($P (X,"^",10) '="") S CH SDEDUCTT=$ J($FN($P(X ,"^",10)," ,",2),11)  S CHSDEDT= CHSDEDUCTT  I CHSDEDT ="" S CHSD EDT=$J("N/ A",11) ;Am ount Appli ed to Dedu ctible: JU ST FOR THI S LOCATION  I TALLOW' ="" S TALL OW=$J($FN( TALLOW,"," ,2),11) I  (TALLOW="" )&($P(X,"^ ",9)'="")  S TALLOW=$ J($FN($P(X ,"^",9),", ",2),11) S  TALLW=""  I ($P(X,"^ ",9)'="")  S TALLW=$J ($FN($P(X, "^",9),"," ,2),11) ;M TN013163F  EW BUG BC  54 9/7/12  I TALLW=""  S TALLW=$ J("N/A",11 ) ;Calcula ted Allowa ble Amount : JUST FOR  THIS LOCA TION MTN01 3163F EW B UG BC 54 9 /7/12 I CH SMEDPDT'=" " S CHSMED PDT=$J($FN (CHSMEDPDT ,",",2),11 ) I (CHSME DPDT="")&( $P(X,"^",2 9)'="") S  CHSMEDPDT= $J($FN($P( X,"^",29), ",",2),11)  ;MTN01316 3F EW BUG  BEN39 6/29 /12 I CHSC SAT'="" S  CHSCSAT=$J ($FN(CHSCS AT,",",2), 11) I (CHS CSAT="")&( $P(X,"^",1 1)'="") S  CHSCSAT=$J ($FN($P(X, "^",11),", ",2),11) S  CHCSAT=CH SCSAT I CH CSAT="" S  CHCSAT=$J( "N/A",11)  ;Cost Shar e Credited  to Cat Ca p: JUST FO R THIS LOC ATION I CH SPAYAT'=""  S CHSPAYA T=$J($FN(C HSPAYAT,", ",2),11) E   S CHSPAY AT=$J($FN( $P(X,"^",1 3),",",2), 11) I $P(X ,"^",25)'= "" S CHTPL =$J($FN($P (X,"^",25) ,",",2),11 ) ;Amount  Paid by TP L E  S CHT PL=$J("N/A ",11) D PR VS I CHDEB '="" S CHD EB=$J($FN( CHDEB,",", 2),11) E   S CHDEB=$J ("N/A",11)  I CHCSTSH R'="" S CH CSTSHR=$J( $FN(CHCSTS HR,",",2), 11) E  S C HCSTSHR=$J ("N/A",11)  I CHPRVSP MT'="" S C HPRVSPMT=$ J($FN(CHPR VSPMT,",", 2),11) E   S CHPRVSPM T=$J("N/A" ,11) I $P( X,"^",12)' ="" S CHOT HIN=$P(X," ^",12)+$P( X,"^",27)  S CHOTHIN= $J($FN(CHO THIN,",",2 ),11) ;Amo unt Paid b y Other In surance: M TN013163F  EW BUG PPR 42 12/10/1 2 E  S CHO THIN=$J("N /A",11) I  CHSOHIPBT' ="" S CHPR ESP=CHSOHI PBT;MTN013 163F EW BU G PPR39 11 /16/12 I ( $P(X,"^",2 4)'="") &  (CHSOHIPBT ="") S CHP RESP=$J($F N($P(X,"^" ,24),",",2 ),11) ;Pat ient Respo nsibility  Amount: JU ST FOR THI S LOCATION  MTN013163 F EW BUG P PR39 11/16 /12 I ($P( X,"^",24)= "") & (CHS OHIPBT="")  S CHPRESP =$J("N/A", 11) ;MTN01 3163F EW B UG PPR39 1 1/16/12 I  $P(X,"^",1 4)'="" S C HPBENV=$J( $FN($P(X," ^",14),"," ,2),11) ;A mount Paid  by Benefi ciary to V endor: JUS T FOR THIS  LOCATION  E  S CHPBE NV=$J("N/A ",11) I $P (X,"^",13) '="" S CHP AIDCL=$J($ FN($P(X,"^ ",13),",", 2),11) ;To tal Amount  to be PAI D on claim : JUST FOR  THIS LOCA TION E  S  CHPAIDCL=$ J("N/A",11 ) I $P(X," ^",15)'=""  S CHPAIDV =$J($FN($P (X,"^",15) ,",",2),11 ) ;Total A mount to b e PAID to  Vendor: JU ST FOR THI S LOCATION  E  S CHPA IDV=$J("N/ A",11) I $ P(X,"^",16 )'="" S CH PAIDB=$J($ FN($P(X,"^ ",16),",", 2),11) ;To tal Amount  to be PAI D to Benef iciary: JU ST FOR THI S LOCATION  E  S CHPA IDB=$J("N/ A",11) I ( $P(X,"^",1 8)=1)&($P( X,"^",17)' ="") S CHC ATCAP=$J($ FN($P(X,"^ ",17),",", 2),11) ;Am ount appli ed to Cat  Cap: JUST  FOR THIS L OCATION E   S CHCATCA P=$J("N/A" ,11) D CIT I ;D MEDI  I $P(X,"^" ,3)'="Inpa tient" D . W !,"Total s:",?30,TC HARGE,?43, TALLOW,?56 ,CHSMEDPDT ,?69,CHSOH IPDT,?82,C HSOHIPRT,? 95,CHSDEDU CTT,?108,C HSPAYAT    .W !,?69,C HSOHIADT,? 82,CHSOHIP BT,?95,CHS CSAT  .W !  S NOTE="" ,SCHDL=""  F  S NOTE= $O(REJLN($ J,"NOTE",N OTE)) Q:NO TE=""  D . S LN=0 F   S LN=$O(RE JLN($J,"NO TE",NOTE,L N)) Q:LN=" "  D ..S R ESULT=$P(R EJLN($J,"N OTE",NOTE, LN),"^",1)  ..S:RESUL T="AC" RES ULT="accep ted"  ..S: RESULT="RE " RESULT=" rejected"   ..S REASO N=$P(REJLN ($J,"NOTE" ,NOTE,LN), "^",2) ..S  QTY=$P(RE JLN($J,"NO TE",NOTE,L N),"^",3)  ..S ADJAMT =$P(REJLN( $J,"NOTE", NOTE,LN)," ^",4) ..S  TADJAMT=$F N(QTY*ADJA MT,",",2), ADJAMT=$FN (ADJAMT,", ",2) ..S ( LN1,QTY1)= 0,ADJAMT1= "" F  S LN 1=$O(REJLN ($J,"NOTE" ,NOTE,LN1) ) Q:LN1=""   D ...S A DJAMT1=$P( REJLN($J," NOTE",NOTE ,LN1),"^", 4) ...I AD JAMT1>0 S  QTY1=QTY1+ 1 ..I LN=1  W !,?2,"N OTE ",NOTE ," - ",QTY ," units " ,RESULT W: REASON'="  " " with r eason ",RE ASON W:((A DJAMT'="") !(REASON=" "))&(QTY1' =1) " @ $" ,ADJAMT,"/ unit=$",TA DJAMT ..E   W !,?12,Q TY," units  ",RESULT  W:REASON'= " " " with  reason ", REASON W:( ADJAMT'="" )&(REASON= " ") " @ $ ",ADJAMT," /unit=$",T ADJAMT .W  ! K REJLN( $J) S NTNU M=0 I $D(V IEWFL) W ! !,"Press < RETURN> to  Continue,  <^> to ex it." R XXX  S:XXX="^"  EXFLG=1 W  ! W ! I C HSMEDPDT=" " S CHSMED PDT=$J("N/ A",11) ;TO  CHANGE TH E COLUMN S PACING THE SE VALUES  ARE THE ON LY ONES TH AT HAVE TO  BE CHANGE D S COL1=4 2,COL2=47, COL3=110,C OL4=113 ;M TN013163F  EW BUG PPR 42 12/10/1 2 ;DGC 11/ 6/13 DEV01 9388 - BEG IN I INP'= "" D .S:$P (INP,"^",1 )="" $P(IN P,"^",1)=" undetermin ed" .S:$P( INP,"^",2) ="" $P(INP ,"^",2)="u ndetermine d" .S:$P(I NP,"^",4)= "" $P(INP, "^",3)="un determined " .I ($P(I NP,"^",1)' ="undeterm ined"),($P (INP,"^",4 )'=0) S $P (INP,"^",2 )="N/A" .I  $P(INP,"^ ",1)="unde termined"  W !!,?(COL 1-$L("DRG: ")),"DRG:" ,?COL2,$P( INP,"^",1)  .E  W !!, ?(COL1-$L( "DRG:"))," DRG:",?COL 2,$P(INP," ^",1) .I $ P(INP,"^", 2)="undete rmined" W  !,?(COL1-$ L("DRG Sta tus:")),"D RG Status: ",?COL2,$P (INP,"^",2 ) .E  W !, ?(COL1-$L( "DRG Statu s:")),"DRG  Status:", ?COL2,$P(I NP,"^",2)  .I $P(INP, "^",3)="un determined " W !,?(CO L1-$L("Met hod of Pay ment:"))," Method of  Payment:", ?COL2,$P(I NP,"^",3)  .E  W !,?( COL1-$L("M ethod of P ayment:")) ,"Method o f Payment: ",?COL2,$P (INP,"^",3 ) ;DGC 11/ 6/13 DEV01 9388 - END  W !!,?(CO L1-$L("Tot al Charges  Billed:") ),"Total C harges Bil led:",?COL 2,TCHARGE, ?(COL3-$L( "CITI Maxi mum Reimbu rsement Ra te:")),"CI TI Maximum  Reimburse ment Rate: ",?COL4,CI TICA W !,? (COL1-$L(" Calculated  Allowable  Amount:") ),"Calcula ted Allowa ble Amount :",?COL2,T ALLW,?(COL 3-$L("MEDI CAID Amoun t:")),"MED ICAID Amou nt:",?COL4 ,CHSMEDPDT  W !,?(COL 1-$L("Amou nt Applied  to Deduct ible:"))," Amount App lied to De ductible:" ,?COL2,CHS DEDT,?(COL 3-$L("Amou nt Paid by  TPL:"))," Amount Pai d by TPL:" ,?COL4,CHT PL W !,?(C OL1-$L("Co st Share C redited to  Cat Cap:" )),"Cost S hare Credi ted to Cat  Cap:",?CO L2,CHCSAT, ?(COL3-$L( "Amount Re versed fro m Deductib le:")),"Am ount Rever sed from D eductible: ",?COL4,CH DEB W !,?( COL1-$L("A mount Paid  by Other  Insurance( s):")),"Am ount Paid  by Other I nsurance(s ):",?COL2, CHOTHIN,?( COL3-$L("A mount Reve rsed from  Cat Cap:") ),"Amount  Reversed f rom Cat Ca p:",?COL4, CHCSTSHR W  !,?(COL1- $L("Patien t Responsi bility Amo unt:")),"P atient Res ponsibilit y Amount:" ,?COL2,CHP RESP,?(COL 3-$L("Amou nt Reduced  from Prev ious Payme nt:")),"Am ount Reduc ed from Pr evious Pay ment:",?CO L4,CHPRVSP MT W !,?(C OL1-$L("Am ount Paid  by Benefic iary to Ve ndor:"))," Amount Pai d by Benef iciary to  Vendor:",? COL2,CHPBE NV W !,?(C OL1-$L("To tal Amount  to be PAI D on claim :")),"Tota l Amount t o be PAID  on claim:" ,?COL2,CHP AIDCL W !, ?(COL1-$L( "Amount PA ID to Vend or:")),"Am ount PAID  to Vendor: ",?COL2,CH PAIDV W !, ?(COL1-$L( "Amount PA ID to Bene ficiary:") ),"Amount  PAID to Be neficiary: ",?COL2,CH PAIDB D .S  CHCLNP=$O (@(GLPAY_" ""B"",CHCL N,0)")) Q: 'CHCLNP .Q :'$D(@(GLP AY_"CHCLNP ,5)")) Q:$ P(@(GLPAY_ "CHCLNP,5) "),"^",1)= "" .S SR=$ P(@(GLPAY_ "CHCLNP,5) "),"^",1)  .W !,?20,$ S(SR=0:"*P ENDING REC OUPMENT*", SR=1:"*PAR TIAL RECOU PMENT RECE IVED*",SR= 2:"*FULL R ECOUPMENT  RECEIVED*" ,SR=3:"*NO  RECOUPMEN T FORTHCOM ING*",1:"" ) QPRVS S  (ZCL,CHPRV SPMT,CHDEB ,CHCSTSHR) ="" S ZCL= $O(@(GLPAY _"""B"",CH CLN,0)"))  Q:'ZCL S P RV=$$PRVSP MT^CHTFLIB 2(ZCL) S Y R="" F  S  YR=$O(^TMP ($J,"PRVSP MT",YR)) Q :YR=""  D  .S CHPRVSP MT=CHPRVSP MT+$P(^TMP ($J,"PRVSP MT",YR),"^ ",1) .S CH DEB=CHDEB+ $P(^TMP($J ,"PRVSPMT" ,YR),"^",2 ) .S CHCST SHR=CHCSTS HR+$P(^TMP ($J,"PRVSP MT",YR),"^ ",3) K ^TM P($J,"PRVS PMT") Q ;- ----- DEV0 07820 EW 8 /9/11 ENDC ITI S ZCL= "",CITICA= $J("N/A",1 1) S ZCL=$ O(@(GLPAY_ """B"",CHC LN,0)")) Q :'ZCL S CI TIVN="" S: $D(@(GLPAY _"ZCL,0)") ) CITIVN=$ P(@(GLPAY_ "ZCL,0)"), "^",3) Q:' CITIVN  Q: '$D(^CHMVE N(CITIVN,1 )) Q:$P(^C HMVEN(CITI VN,1),"^", 16)'=1 S C ITICA="" S :$D(@(GLPA Y_"ZCL,1)" )) CITICA= $P(@(GLPAY _"ZCL,1)") ,"^",28) I  CITICA'=" " S CITICA =$J($FN(CI TICA,",",2 ),11) E  S  CITICA=$J ("N/A",11)  ;I CITICA ="" W !,?1 1,"CITI Ma ximum Reim bursment R ate: ",?46 ,"undeterm ined" ;E W  !,?11,"CI TI Maximum  Reimbursm ent Rate:  ",?48,$J($ FN(CITICA, ",",2),10)  Q ;MEDI S  ZCL="",CH SMEDPDT=$J ("N/A",11)  S ZCL=$O( @(GLPAY_"" "B"",CHCLN ,0)")) Q:' ZCL Q:'$D( @(GLPAY_"Z CL,7)")) S  MEDIA=$P( @(GLPAY_"Z CL,7)"),"^ ",2) I MED IA'="" S C HSMEDPDT=$ J($FN(MEDI A,",",2),1 1) E  S CH SMEDPDT=$J ("N/A",11)  ;I MEDIA' ="" W !,?2 6,"MEDICAI D Amount:  ",?48,$J($ FN(MEDIA," ,",2),10)  Q ;DEDT I  $D(VIEWFL)  W !!,"Pre ss <RETURN > to Conti nue, <^> t o exit." R  XXX S:XXX ="^" EXFLG =1 W ! ;E  I $Y>53 W  @IOF D HEA D W ! ;W ! !,?5,"OCHA MPUS Benef iciary Ded uctible ", $P(X3,"^", 10),": ",? 45,"$",$J( $FN($P(X3, "^",2),"", 2),10) W ! ,?6,"CHAMP VA Benefic iary Deduc tible ",$P (X3,"^",10 ),": ",?48 ,$J($FN($P (X3,"^",1) ,"",2),10)  W:($P(X3, "^",7)'=0) &($P(X3,"^ ",7)'="")  ?60,"(sati sfied)" ;W  !!,?10,"O CHAMPUS Fa mily Deduc tible ",$P (X3,"^",10 ),": ",?45 ,"$",$J($F N($P(X3,"^ ",4),"",2) ,10) W !,? 11,"CHAMPV A Family D eductible  ",$P(X3,"^ ",10),": " ,?48,$J($F N($P(X3,"^ ",3),"",2) ,10) W:($P (X3,"^",8) '=0)&($P(X 3,"^",8)'= "") ?60,"( satisfied) " ;W !!,?4 ,"OCHAMPUS  Family Ca tastrophic  Cap ",$P( X3,"^",10) ,": ",?45, "$",$J($FN ($P(X3,"^" ,6),"",2), 10) S:$P(X 3,"^",5)<0  $P(X3,"^" ,5)=0 W !, ?5,"CHAMPV A Family C atastrophi c Cap ",$P (X3,"^",10 ),": ",?48 ,$J($FN($P (X3,"^",5) ,"",2),10)  W:($P(X3, "^",9)'=0) &($P(X3,"^ ",9)'="")  ?60,"(sati sfied)" Q  ;REOPEN K  REOPEN,FLA G S JJ=CHP PTR,II=JJ, CT=1 D:$D( @(GLPAY_"J J,6)")) .S  X1=JJ D P ROGTYP^CHF CD001 ; Se t for ever y reopen c laim .F  S  II=$P($G( @(GLPAY_"J J,6)")),"^ ",2) Q:II= ""  S REOP EN(CT,II)= "",JJ=II,C T=CT+1 I $ D(REOPEN)  D .S CT=0R 1 .S CT=$O (REOPEN(CT )) Q:'CT   S RECLM=0R 2 .S RECLM =$O(REOPEN (CT,RECLM) ) G:'RECLM  R1 .S X1= RECLM D PR OGTYP^CHFC D001 .G:'$ D(@(GLPAY_ "RECLM,0)" )) R1 .S P DICPT=RECL M D PDIS . I $P(^TMP( $J,"CL",CH CLN),"^",3 )="Inpatie nt" S COL1 =10,COL2=1 1,COL3=35, COL4=36,CO L5=65,COL6 =66 ;MTN01 3163: SLA  EW 1/14/13  .;------- --START DE V007820 PP R BUG 23 E W 5/30/12  .;W " PDI:  ",CHPDI_" -"_CHDOC,"  BATCH: ", CHBATCH  . ;I '$D(FLA G) W ?55," (Reopens):  " S FLAG= 1 .;W ?66, $P(@(GLPAY _"RECLM,0) "),"^",1)  .W ?(COL1- $L("PDI:") ),"PDI:",? COL2,CHPDI _"-"_CHDOC ,?(COL3-$L ("BATCH:") ),"BATCH:" ,?COL4,CHB ATCH .I '$ D(FLAG) W  ?(COL5-$L( "(Reopens) :")),"(Reo pens):";MT N013163: B UG FIX PPR 34 SLA EW  9/17/12 .W  ?COL6,$P( @(GLPAY_"R ECLM,0)"), "^",1) S F LAG=1 ;MTN 013163: BU G FIX PPR3 4 SLA EW 9 /17/12 .;- --------EN D DEV00782 0 PPR BUG  23 EW 5/30 /12 .I $O( REOPEN(CT, RECLM)) W  ! G R2 .I  $O(REOPEN( CT)) W ! G  R2 .G R2R EXIT S X1= CHPPTR D P ROGTYP^CHF CD001 ; Se t back to  original c laim QPDIS  S CHPDI=" ",CHDOC="" ,CHBATCH=" " Q:'$D(PD ICPT) Q:PD ICPT="" S  JJ=999999  S JJ=$O(@( GLPAY_"PDI CPT,""PDI" ",JJ)"),-1 ) I JJ I $ D(@(GLPAY_ "PDICPT,"" PDI"",JJ,0 )")) D .S  CHPDI=$P(@ (GLPAY_"PD ICPT,""PDI "",JJ,0)") ,"^",1) .I  CHPDI I $ D(^CHMIMG( CHPDI,"DOC ")) S CHDO C=$P(^("DO C"),"^",1)  .I $D(^CH MIMPB("C", CHPDI)) D  ..S JJJ=0, JJJ=$O(^CH MIMPB("C", CHPDI,JJJ) ) ..I JJJ  I $D(^CHMI MPB(JJJ,0) ) S CHBATC H=$P(^(0), "^",1) QRE ASON S RSP T="" S:$P( @(GLPAY_"C HPPTR,0)") ,"^",13)'= "" RSPT=$P (@(GLPAY_" CHPPTR,0)" ),"^",13)  I RSPT I $ D(^CHMDIC( 741002.22, RSPT,0)) S  CLREAS($P (^(0),"^", 1))=$E($P( ^(0),"^",2 ),1,104) ; USE TO BE  LIMITED TO  70 DEV007 820 BUG PP R25 EW 8/2 /12 G:'$D( @(GLPAY_"C HPPTR,4)") ) RS2 S JJ =0RS1 S JJ =$O(@(GLPA Y_"CHPPTR, 4,JJ)")) G :'JJ RS2 S  FIL0="^"_ GLPAY_CHPP TR_",4,"_J J_",0)" G: '$D(@(GLPA Y_"CHPPTR, 4,JJ,0)"))  RS1 S RSP T=$P(@(GLP AY_"CHPPTR ,4,JJ,0)") ,"^",1) I  RSPT I $D( ^CHMDIC(74 1002.22,RS PT,0)) S C LREAS($P(^ (0),"^",1) )=$E($P(^( 0),"^",2), 1,104) ;US E TO BE LI MITED TO 7 0 DEV00782 0 BUG PPR2 5 EW 8/2/1 2 G RS1RS2  W ! G:'$D (CLREAS) R S4 W !!,"C laim Reaso ns: " S JJ =0RS3 S JJ =$O(CLREAS (JJ)) G:JJ ="" RS4 W  ?20,JJ," -  ",$E(CLRE AS(JJ),1,1 04),! G RS 3;USE TO B E LIMITED  TO 53 DEV0 07820 BUG  PPR25 EW 8 /2/12RS4 Q :'$D(LNREA S) S JJ="" RS5 S JJ=$ O(LNREAS(J J)) G:JJ=" " RS6 S TJ J=$P(JJ,"* ",1),RTNPR O=$P(JJ,"* ",2) G:'$D (^CHMDIC(7 41002.22," B",TJJ)) R S5 S RSPT= 0,RSPT=$O( ^CHMDIC(74 1002.22,"B ",TJJ,RSPT )) I RSPT  I $D(^CHMD IC(741002. 22,RSPT,0) ) S LIREAS (JJ)=$E($P (^(0),"^", 2),1,104)  ;USE TO BE  LIMITED T O 70 DEV00 7820 BUG P PR25 EW 8/ 2/12 G RS5 RS6 Q:'$D( LIREAS) W  !,"Line It em Reasons : " S JJ=" "RS7 S JJ= $O(LIREAS( JJ)) Q:JJ= "" S TJJ=$ P(JJ,"*",1 ),REASON1= $E(LIREAS( JJ),1,104)  ;USE TO B E LIMITED  TO 53 DEV0 07820 BUG  PPR25 EW 8 /2/12 ;//B EG REMARK  OUT REBUND LING, SKD  3-22-07 DE V000099-01 // ;I (TJJ =1006)!(TJ J=1007)!(T JJ=1009) D   ;//END R EMARK OUT  REBUNDLING , SKD 3-22 -07 DEV000 099-01// I  (TJJ=1006 )!(TJJ=100 7) D   ;TH IS LINE NE EDS TO BE  REPLACED L ATER FOR R EBUNDLING  .K SPEC S  SNTPRO=$P( JJ,"*",2), SPEC("XXXX X")=SNTPRO  .S REASON 1=$$REPLAC E^XLFSTR(R EASON1,.SP EC) K SPEC  .S RNTPRO =LNREAS(JJ ),SPEC("YY YYY")=RNTP RO .S REAS ON1=$$REPL ACE^XLFSTR (REASON1,. SPEC) K SP EC .S REAS ON1=$E(REA SON1,1,104 ) ;DEV0078 20 BUG PPR 25 EW 8/2/ 12 ;//BEG  REMARK OUT  REBUNDLIN G, SKD 3-2 2-07 DEV00 0099-01//  ;I TJJ=101 0 D ;SKD 2 -21-07 CC8 .5 ;.K SPE C S SNTPRO =$P(JJ,"*" ,2),SPEC(" YYYYY")=SN TPRO ;.S R EASON1=$$R EPLACE^XLF STR(REASON 1,.SPEC) K  SPEC ;//E ND REMARK  OUT REBUND LING, SKD  3-22-07 DE V000099-01 // W ?20,T JJ," - ",R EASON1,! G  RS7CHECKS  S J=0CHK1  S J=$O(@( GLPAY_"CHP PTR,102,J) ")) G:'J C HK2 Q:'$D( @(GLPAY_"C HPPTR,102, J,0)")) S  CHECKS($P( @(GLPAY_"C HPPTR,102, J,0)"),"^" ,1))="" S: $P(@(GLPAY _"CHPPTR,1 02,J,0)"), "^",4)=1 C HECKS($P(@ (GLPAY_"CH PPTR,102,J ,0)"),"^", 1))=" (Ret )" I $P(@( GLPAY_"CHP PTR,102,J, 0)"),"^",8 )'="" D .S  REDATE=$P (@(GLPAY_" CHPPTR,102 ,J,0)"),"^ ",8) .S RE DATE=$E(RE DATE,4,5)_ "/"_$E(RED ATE,6,7)_" /"_$E(REDA TE,2,3) .S  CHECKS($P (@(GLPAY_" CHPPTR,102 ,J,0)"),"^ ",1))=" (R eis) "_RED ATE G CHK1 CHK2 Q:'$D (CHECKS) S  CHKNM=""  S TAB=12,L LEN=12 W ! !,"Check # 's:"CHHK3  S CHKNM=$O (CHECKS(CH KNM)) Q:CH KNM="" S L LEN=LLEN+$ L(CHKNM)+4 +$L(CHECKS (CHKNM)) I  LLEN>80 S  TAB=12,LL EN=12 W !  W ?TAB,CHK NM,CHECKS( CHKNM) S T AB=TAB+LLE N G CHHK3
  7  
  8   New versio n (New or  changed po rtions; Hi ghlight al l of the f ollowing:   New - Bol d, Deleted  - Striket hru, Chang ed - Itali cs)
  9  
  10   CHMF351U ; DEH/DEN;UT ILITY FILE  FOR PPR P RINT ;05/2 7/99 10:47  AM ;;1.0; CHAMPVA SY STEM;;JULY  4, 1990;B uild 10 ;; V1.0;; ;CP TS #12621*  (RLC), #1 3782* (RLC ) , 16785  (AEB) ;THI S ROUTINE  CREATED TO  DOWNSIZE  CHMF351P ;  DEV7820 E W 3/17/11  Add line l evel TOTAL  data and  notes ;DEV 019388 11/ 5/13 DGC -  Change in  INP proce ssing ;CFS  10/18/201 7 CPE005-0 95 - Add t otal of al l claims f or Origina l and Curr ent PDI's.  ;BOT  ; ; ------ DEV 7820 EW 8/ 9/11 START   I $P(X," ^",3)="Inp atient" D  .S SORT="" ,CHSOHIPDT ="",CHSOHI PRT="",CHS DEDUCTT="" ,CHSMEDPDT ="",CHSOHI ADT="",CHS OHIPBT="", CHSCSAT="" ,CHSPAYAT= "",SPBIF=0 ,TCHARGE=" ",TALLOW=" " ;DGC 1/1 3/14 BUG01 9388 .S CH CLNP=$O(@( GLPAY_"""B "",CHCLN,0 )")) Q:'CH CLNP .I $D (@(GLPAY_" CHCLNP,""I NP"")")) D                                                           ;DGC 11 /5/13 DEV0 19388 ..S: $P(@(GLPAY _"CHCLNP," "INP"")"), "^",10)'=" " TCHARGE= $J($FN($P( X,"^",8)," ,",2),11)_ "A" ;DGC 1 1/5/13 DEV 019388 ..S :$P(@(GLPA Y_"CHCLNP, ""INP"")") ,"^",10)=" " TCHARGE= $J($FN($P( X,"^",8)," ,",2),11)  ;DGC 11/5/ 13 DEV0193 88 E  S TC HARGE=$J($ FN(TCHARGE ,",",2),11 ) I $P(X," ^",3)'="In patient" W  !,"------ ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------"  ;DGC 1/13 /14 BUG019 388 E  W ! ! ;DGC 1/1 3/14 BUG01 9388 ;IF N O SLA DATA  USE CLAIM  S CHTPL=" " I CHSOHI PDT'="" S  CHSOHIPDT= $J($FN(CHS OHIPDT,"," ,2),11) I  (CHSOHIPDT ="")&($P(X ,"^",12)'= "") S CHSO HIPDT=$J($ FN($P(X,"^ ",12),",", 2),11) I C HSOHIPRT'= "" S CHSOH IPRT=$J($F N(CHSOHIPR T,",",2),1 1) I (CHSO HIPRT="")& ($P(X,"^", 24)'="") S  CHSOHIPRT =$J($FN($P (X,"^",24) ,",",2),11 ) I CHSOHI ADT'="" S  CHSOHIADT= $J($FN(CHS OHIADT,"," ,2),11) I  (CHSOHIADT ="")&($P(X ,"^",27)'= "") S CHSO HIADT=$J($ FN($P(X,"^ ",27),",", 2),11) ;MT N013163F E W BUG BEN3 9 6/29/12  I CHSOHIPB T'="" S CH SOHIPBT=$J ($FN(CHSOH IPBT,",",2 ),11) I (C HSOHIPBT=" ")&($P(X," ^",28)'="" ) S CHSOHI PBT=$J($FN ($P(X,"^", 28),",",2) ,11) ;MTN0 13163F EW  BUG BEN39  6/29/12 I  CHSDEDUCTT '="" S CHS DEDUCTT=$J ($FN(CHSDE DUCTT,",", 2),11) I ( CHSDEDUCTT ="")&($P(X ,"^",10)'= "") S CHSD EDUCTT=$J( $FN($P(X," ^",10),"," ,2),11) S  CHSDEDT=CH SDEDUCTT I  CHSDEDT=" " S CHSDED T=$J("N/A" ,11) ;Amou nt Applied  to Deduct ible: JUST  FOR THIS  LOCATION I  TALLOW'=" " S TALLOW =$J($FN(TA LLOW,",",2 ),11) I (T ALLOW="")& ($P(X,"^", 9)'="") S  TALLOW=$J( $FN($P(X," ^",9),",", 2),11) S T ALLW="" I  ($P(X,"^", 9)'="") S  TALLW=$J($ FN($P(X,"^ ",9),",",2 ),11) ;MTN 013163F EW  BUG BC 54  9/7/12 I  TALLW="" S  TALLW=$J( "N/A",11)  ;Calculate d Allowabl e Amount:  JUST FOR T HIS LOCATI ON MTN0131 63F EW BUG  BC 54 9/7 /12 I CHSM EDPDT'=""  S CHSMEDPD T=$J($FN(C HSMEDPDT," ,",2),11)  I (CHSMEDP DT="")&($P (X,"^",29) '="") S CH SMEDPDT=$J ($FN($P(X, "^",29),", ",2),11) ; MTN013163F  EW BUG BE N39 6/29/1 2 I CHSCSA T'="" S CH SCSAT=$J($ FN(CHSCSAT ,",",2),11 ) I (CHSCS AT="")&($P (X,"^",11) '="") S CH SCSAT=$J($ FN($P(X,"^ ",11),",", 2),11) S C HCSAT=CHSC SAT I CHCS AT="" S CH CSAT=$J("N /A",11) ;C ost Share  Credited t o Cat Cap:  JUST FOR  THIS LOCAT ION I CHSP AYAT'="" S  CHSPAYAT= $J($FN(CHS PAYAT,",", 2),11) E   S CHSPAYAT =$J($FN($P (X,"^",13) ,",",2),11 ) I $P(X," ^",25)'=""  S CHTPL=$ J($FN($P(X ,"^",25)," ,",2),11)  ;Amount Pa id by TPL  E  S CHTPL =$J("N/A", 11) D PRVS  I CHDEB'= "" S CHDEB =$J($FN(CH DEB,",",2) ,11) E  S  CHDEB=$J(" N/A",11) I  CHCSTSHR' ="" S CHCS TSHR=$J($F N(CHCSTSHR ,",",2),11 ) E  S CHC STSHR=$J(" N/A",11) I  CHPRVSPMT '="" S CHP RVSPMT=$J( $FN(CHPRVS PMT,",",2) ,11) E  S  CHPRVSPMT= $J("N/A",1 1) I $P(X, "^",12)'=" " S CHOTHI N=$P(X,"^" ,12)+$P(X, "^",27) S  CHOTHIN=$J ($FN(CHOTH IN,",",2), 11) ;Amoun t Paid by  Other Insu rance: MTN 013163F EW  BUG PPR42  12/10/12  E  S CHOTH IN=$J("N/A ",11) I CH SOHIPBT'=" " S CHPRES P=CHSOHIPB T  ;MTN013 163F EW BU G PPR39 11 /16/12 I ( $P(X,"^",2 4)'="") &  (CHSOHIPBT ="") S CHP RESP=$J($F N($P(X,"^" ,24),",",2 ),11) ;Pat ient Respo nsibility  Amount: JU ST FOR THI S LOCATION  MTN013163 F EW BUG P PR39 11/16 /12 I ($P( X,"^",24)= "") & (CHS OHIPBT="")  S CHPRESP =$J("N/A", 11) ;MTN01 3163F EW B UG PPR39 1 1/16/12 I  $P(X,"^",1 4)'="" S C HPBENV=$J( $FN($P(X," ^",14),"," ,2),11) ;A mount Paid  by Benefi ciary to V endor: JUS T FOR THIS  LOCATION  E  S CHPBE NV=$J("N/A ",11) I $P (X,"^",13) '="" S CHP AIDCL=$J($ FN($P(X,"^ ",13),",", 2),11) ;To tal Amount  to be PAI D on claim : JUST FOR  THIS LOCA TION E  S  CHPAIDCL=$ J("N/A",11 ) I $P(X," ^",15)'=""  S CHPAIDV =$J($FN($P (X,"^",15) ,",",2),11 ) ;Total A mount to b e PAID to  Vendor: JU ST FOR THI S LOCATION  E  S CHPA IDV=$J("N/ A",11) I $ P(X,"^",16 )'="" S CH PAIDB=$J($ FN($P(X,"^ ",16),",", 2),11) ;To tal Amount  to be PAI D to Benef iciary: JU ST FOR THI S LOCATION  E  S CHPA IDB=$J("N/ A",11) I ( $P(X,"^",1 8)=1)&($P( X,"^",17)' ="") S CHC ATCAP=$J($ FN($P(X,"^ ",17),",", 2),11) ;Am ount appli ed to Cat  Cap: JUST  FOR THIS L OCATION E   S CHCATCA P=$J("N/A" ,11) D CIT I ;D MEDI  I $P(X,"^" ,3)'="Inpa tient" D . W !,"Total s:",?30,TC HARGE,?43, TALLOW,?56 ,CHSMEDPDT ,?69,CHSOH IPDT,?82,C HSOHIPRT,? 95,CHSDEDU CTT,?108,C HSPAYAT .W  !,?69,CHS OHIADT,?82 ,CHSOHIPBT ,?95,CHSCS AT .W ! S  NOTE="",SC HDL="" F   S NOTE=$O( REJLN($J," NOTE",NOTE )) Q:NOTE= ""  D .S L N=0 F  S L N=$O(REJLN ($J,"NOTE" ,NOTE,LN))  Q:LN=""   D ..S RESU LT=$P(REJL N($J,"NOTE ",NOTE,LN) ,"^",1) .. S:RESULT=" AC" RESULT ="accepted " ..S:RESU LT="RE" RE SULT="reje cted" ..S  REASON=$P( REJLN($J," NOTE",NOTE ,LN),"^",2 ) ..S QTY= $P(REJLN($ J,"NOTE",N OTE,LN),"^ ",3) ..S A DJAMT=$P(R EJLN($J,"N OTE",NOTE, LN),"^",4)  ..S TADJA MT=$FN(QTY *ADJAMT,", ",2),ADJAM T=$FN(ADJA MT,",",2)  ..S (LN1,Q TY1)=0,ADJ AMT1="" F   S LN1=$O( REJLN($J," NOTE",NOTE ,LN1)) Q:L N1=""  D . ..S ADJAMT 1=$P(REJLN ($J,"NOTE" ,NOTE,LN1) ,"^",4) .. .I ADJAMT1 >0 S QTY1= QTY1+1 ..I  LN=1 W !, ?2,"NOTE " ,NOTE," -  ",QTY," un its ",RESU LT W:REASO N'=" " " w ith reason  ",REASON  W:((ADJAMT '="")!(REA SON=""))&( QTY1'=1) "  @ $",ADJA MT,"/unit= $",TADJAMT  ..E  W !, ?12,QTY,"  units ",RE SULT W:REA SON'=" " "  with reas on ",REASO N W:(ADJAM T'="")&(RE ASON=" ")  " @ $",ADJ AMT,"/unit =$",TADJAM T .W ! K R EJLN($J) S  NTNUM=0 I  $D(VIEWFL ) W !!,"Pr ess <RETUR N> to Cont inue, <^>  to exit."  R XXX S:XX X="^" EXFL G=1 W ! W  ! I CHSMED PDT="" S C HSMEDPDT=$ J("N/A",11 ) ;TO CHAN GE THE COL UMN SPACIN G THESE VA LUES ARE T HE ONLY ON ES THAT HA VE TO BE C HANGED S C OL1=42,COL 2=47,COL3= 110,COL4=1 13 ;MTN013 163F EW BU G PPR42 12 /10/12 ;DG C 11/6/13  DEV019388  - BEGIN I  INP'="" D  .S:$P(INP, "^",1)=""  $P(INP,"^" ,1)="undet ermined" . S:$P(INP," ^",2)="" $ P(INP,"^", 2)="undete rmined" .S :$P(INP,"^ ",4)="" $P (INP,"^",3 )="undeter mined" .I  ($P(INP,"^ ",1)'="und etermined" ),($P(INP, "^",4)'=0)  S $P(INP, "^",2)="N/ A" .I $P(I NP,"^",1)= "undetermi ned" W !!, ?(COL1-$L( "DRG:"))," DRG:",?COL 2,$P(INP," ^",1) .E   W !!,?(COL 1-$L("DRG: ")),"DRG:" ,?COL2,$P( INP,"^",1)  .I $P(INP ,"^",2)="u ndetermine d" W !,?(C OL1-$L("DR G Status:" )),"DRG St atus:",?CO L2,$P(INP, "^",2) .E   W !,?(COL 1-$L("DRG  Status:")) ,"DRG Stat us:",?COL2 ,$P(INP,"^ ",2) .I $P (INP,"^",3 )="undeter mined" W ! ,?(COL1-$L ("Method o f Payment: ")),"Metho d of Payme nt:",?COL2 ,$P(INP,"^ ",3) .E  W  !,?(COL1- $L("Method  of Paymen t:")),"Met hod of Pay ment:",?CO L2,$P(INP, "^",3) ;DG C 11/6/13  DEV019388  - END W !! ,?(COL1-$L ("Total Ch arges Bill ed:")),"To tal Charge s Billed:" ,?COL2,TCH ARGE,?(COL 3-$L("CITI  Maximum R eimburseme nt Rate:") ),"CITI Ma ximum Reim bursement  Rate:",?CO L4,CITICA  W !,?(COL1 -$L("Calcu lated Allo wable Amou nt:")),"Ca lculated A llowable A mount:",?C OL2,TALLW, ?(COL3-$L( "MEDICAID  Amount:")) ,"MEDICAID  Amount:", ?COL4,CHSM EDPDT W !, ?(COL1-$L( "Amount Ap plied to D eductible: ")),"Amoun t Applied  to Deducti ble:",?COL 2,CHSDEDT, ?(COL3-$L( "Amount Pa id by TPL: ")),"Amoun t Paid by  TPL:",?COL 4,CHTPL W  !,?(COL1-$ L("Cost Sh are Credit ed to Cat  Cap:")),"C ost Share  Credited t o Cat Cap: ",?COL2,CH CSAT,?(COL 3-$L("Amou nt Reverse d from Ded uctible:") ),"Amount  Reversed f rom Deduct ible:",?CO L4,CHDEB W  !,?(COL1- $L("Amount  Paid by O ther Insur ance(s):") ),"Amount  Paid by Ot her Insura nce(s):",? COL2,CHOTH IN,?(COL3- $L("Amount  Reversed  from Cat C ap:")),"Am ount Rever sed from C at Cap:",? COL4,CHCST SHR W !,?( COL1-$L("P atient Res ponsibilit y Amount:" )),"Patien t Responsi bility Amo unt:",?COL 2,CHPRESP, ?(COL3-$L( "Amount Re duced from  Previous  Payment:") ),"Amount  Reduced fr om Previou s Payment: ",?COL4,CH PRVSPMT N  J,CHMFPDI, PDDATA,TOT PAID F J=1 :1:4 D  ;C PE005-095  .S PDDATA= $G(PAIDARY (J)) .S CH MFPDI=$P(P DDATA,"^") ,TOTPAID=$ P(PDDATA," ^",2) .I T OTPAID'["- ",TOTPAID' =0 S TOTPA ID=$J($FN( TOTPAID,"+ ,",2),11)  .I TOTPAID ["-",TOTPA ID'=0 S TO TPAID=$J(T OTPAID,11, 2) .I TOTP AID=0 S TO TPAID=$J(T OTPAID,11, 2) .I J=1  D ..W !,?( COL1-$L("A mount Paid  by Benefi ciary to V endor:")), "Amount Pa id by Bene ficiary to  Vendor:", ?COL2,CHPB ENV ..I PD DATA'="" W  ?(COL3-$L ("Total Pa yment for  PDI# NNNNN NNNNNNNNNN :")),"Tota l Payment  for PDI# " _CHMFPDI_" :",?COL4,T OTPAID .I  J=2 D ..W  !,?(COL1-$ L("Total A mount to b e PAID on  claim:")), "Total Amo unt to be  PAID on cl aim:",?COL 2,CHPAIDCL  ..I PDDAT A'="" W ?( COL3-$L("T otal Payme nt for PDI # NNNNNNNN NNNNNNN:") ),"Total P ayment for  PDI# "_CH MFPDI_":", ?COL4,TOTP AID .I J=3  D ..W !,? (COL1-$L(" Amount PAI D to Vendo r:")),"Amo unt PAID t o Vendor:" ,?COL2,CHP AIDV ..I P DDATA'=""  W ?(COL3-$ L("Total P ayment for  PDI# NNNN NNNNNNNNNN N:")),"Tot al Payment  for PDI#  "_CHMFPDI_ ":",?COL4, TOTPAID .I  J=4 D ..W  !,?(COL1- $L("Amount  PAID to B eneficiary :")),"Amou nt PAID to  Beneficia ry:",?COL2 ,CHPAIDB . .I PDDATA' ="" W ?(CO L3-$L("Tot al Payment  for PDI#  NNNNNNNNNN NNNNN:")), "Total Pay ment for P DI# "_CHMF PDI_":",?C OL4,TOTPAI D I PAIDAR Y>4 D  ;CP E005-095 . F J=5:1:PA IDARY D .. S PDDATA=P AIDARY(J)  ..S CHMFPD I=$P(PDDAT A,"^"),TOT PAID=$P(PD DATA,"^",2 ) ..I TOTP AID'["-",T OTPAID'=0  S TOTPAID= $J($FN(TOT PAID,"+,", 2),11) ..I  TOTPAID[" -",TOTPAID '=0 S TOTP AID=$J(TOT PAID,11,2)  ..I TOTPA ID=0 S TOT PAID=$J(TO TPAID,11,2 ) ..W !,?( COL3-$L("T otal Payme nt for PDI # NNNNNNNN NNNNNNN:") ),"Total P ayment for  PDI# "_CH MFPDI_":", ?COL4,TOTP AID D .S C HCLNP=$O(@ (GLPAY_""" B"",CHCLN, 0)")) Q:'C HCLNP .Q:' $D(@(GLPAY _"CHCLNP,5 )")) Q:$P( @(GLPAY_"C HCLNP,5)") ,"^",1)=""  .S SR=$P( @(GLPAY_"C HCLNP,5)") ,"^",1) .W  !,?20,$S( SR=0:"*PEN DING RECOU PMENT*",SR =1:"*PARTI AL RECOUPM ENT RECEIV ED*",SR=2: "*FULL REC OUPMENT RE CEIVED*",S R=3:"*NO R ECOUPMENT  FORTHCOMIN G*",1:"")  QPRVS S (Z CL,CHPRVSP MT,CHDEB,C HCSTSHR)=" " S ZCL=$O (@(GLPAY_" ""B"",CHCL N,0)")) Q: 'ZCL S PRV =$$PRVSPMT ^CHTFLIB2( ZCL) S YR= "" F  S YR =$O(^TMP($ J,"PRVSPMT ",YR)) Q:Y R=""  D .S  CHPRVSPMT =CHPRVSPMT +$P(^TMP($ J,"PRVSPMT ",YR),"^", 1) .S CHDE B=CHDEB+$P (^TMP($J," PRVSPMT",Y R),"^",2)  .S CHCSTSH R=CHCSTSHR +$P(^TMP($ J,"PRVSPMT ",YR),"^", 3) K ^TMP( $J,"PRVSPM T") Q ;--- --- DEV007 820 EW 8/9 /11 ENDCIT I S ZCL="" ,CITICA=$J ("N/A",11)  S ZCL=$O( @(GLPAY_"" "B"",CHCLN ,0)")) Q:' ZCL S CITI VN="" S:$D (@(GLPAY_" ZCL,0)"))  CITIVN=$P( @(GLPAY_"Z CL,0)"),"^ ",3) Q:'CI TIVN  Q:'$ D(^CHMVEN( CITIVN,1))  Q:$P(^CHM VEN(CITIVN ,1),"^",16 )'=1 S CIT ICA="" S:$ D(@(GLPAY_ "ZCL,1)"))  CITICA=$P (@(GLPAY_" ZCL,1)")," ^",28) I C ITICA'=""  S CITICA=$ J($FN(CITI CA,",",2), 11) E  S C ITICA=$J(" N/A",11) ; I CITICA=" " W !,?11, "CITI Maxi mum Reimbu rsment Rat e: ",?46," undetermin ed" ;E W ! ,?11,"CITI  Maximum R eimbursmen t Rate: ", ?48,$J($FN (CITICA,", ",2),10) Q  ;MEDI S Z CL="",CHSM EDPDT=$J(" N/A",11) S  ZCL=$O(@( GLPAY_"""B "",CHCLN,0 )")) Q:'ZC L Q:'$D(@( GLPAY_"ZCL ,7)")) S M EDIA=$P(@( GLPAY_"ZCL ,7)"),"^", 2) I MEDIA '="" S CHS MEDPDT=$J( $FN(MEDIA, ",",2),11)  E  S CHSM EDPDT=$J(" N/A",11) ; I MEDIA'=" " W !,?26, "MEDICAID  Amount: ", ?48,$J($FN (MEDIA,"," ,2),10) Q  ;DEDT I $D (VIEWFL) W  !!,"Press  <RETURN>  to Continu e, <^> to  exit." R X XX S:XXX=" ^" EXFLG=1  W ! ;E I  $Y>53 W @I OF D HEAD  W ! ;W !!, ?5,"OCHAMP US Benefic iary Deduc tible ",$P (X3,"^",10 ),": ",?45 ,"$",$J($F N($P(X3,"^ ",2),"",2) ,10) W !,? 6,"CHAMPVA  Beneficia ry Deducti ble ",$P(X 3,"^",10), ": ",?48,$ J($FN($P(X 3,"^",1)," ",2),10) W :($P(X3,"^ ",7)'=0)&( $P(X3,"^", 7)'="") ?6 0,"(satisf ied)" ;W ! !,?10,"OCH AMPUS Fami ly Deducti ble ",$P(X 3,"^",10), ": ",?45," $",$J($FN( $P(X3,"^", 4),"",2),1 0) W !,?11 ,"CHAMPVA  Family Ded uctible ", $P(X3,"^", 10),": ",? 48,$J($FN( $P(X3,"^", 3),"",2),1 0) W:($P(X 3,"^",8)'= 0)&($P(X3, "^",8)'="" ) ?60,"(sa tisfied)"  ;W !!,?4," OCHAMPUS F amily Cata strophic C ap ",$P(X3 ,"^",10)," : ",?45,"$ ",$J($FN($ P(X3,"^",6 ),"",2),10 ) S:$P(X3, "^",5)<0 $ P(X3,"^",5 )=0 W !,?5 ,"CHAMPVA  Family Cat astrophic  Cap ",$P(X 3,"^",10), ": ",?48,$ J($FN($P(X 3,"^",5)," ",2),10) W :($P(X3,"^ ",9)'=0)&( $P(X3,"^", 9)'="") ?6 0,"(satisf ied)" Q ;R EOPEN K RE OPEN,FLAG  S JJ=CHPPT R,II=JJ,CT =1 D:$D(@( GLPAY_"JJ, 6)")) .S X 1=JJ D PRO GTYP^CHFCD 001 ; Set  for every  reopen cla im .F  S I I=$P($G(@( GLPAY_"JJ, 6)")),"^", 2) Q:II=""   S REOPEN (CT,II)="" ,JJ=II,CT= CT+1 I $D( REOPEN) D  .S CT=0R1  .S CT=$O(R EOPEN(CT))  Q:'CT  S  RECLM=0R2  .S RECLM=$ O(REOPEN(C T,RECLM))  G:'RECLM R 1 .S X1=RE CLM D PROG TYP^CHFCD0 01 .G:'$D( @(GLPAY_"R ECLM,0)"))  R1 .S PDI CPT=RECLM  D PDIS .I  $P(^TMP($J ,"CL",CHCL N),"^",3)= "Inpatient " S COL1=1 0,COL2=11, COL3=35,CO L4=36,COL5 =65,COL6=6 6 ;MTN0131 63: SLA EW  1/14/13 . ;--------- START DEV0 07820 PPR  BUG 23 EW  5/30/12 .; W " PDI: " ,CHPDI_"-" _CHDOC," B ATCH: ",CH BATCH .;I  '$D(FLAG)  W ?55,"(Re opens): "  S FLAG=1 . ;W ?66,$P( @(GLPAY_"R ECLM,0)"), "^",1) .W  ?(COL1-$L( "PDI:"))," PDI:",?COL 2,CHPDI_"- "_CHDOC,?( COL3-$L("B ATCH:"))," BATCH:",?C OL4,CHBATC H .I '$D(F LAG) W ?(C OL5-$L("(R eopens):") ),"(Reopen s):"  ;MTN 013163: BU G FIX PPR3 4 SLA EW 9 /17/12 .W  ?COL6,$P(@ (GLPAY_"RE CLM,0)")," ^",1) S FL AG=1 ;MTN0 13163: BUG  FIX PPR34  SLA EW 9/ 17/12 .;-- -------END  DEV007820  PPR BUG 2 3 EW 5/30/ 12 .I $O(R EOPEN(CT,R ECLM)) W !  G R2 .I $ O(REOPEN(C T)) W ! G  R2 .G R2RE XIT S X1=C HPPTR D PR OGTYP^CHFC D001 ; Set  back to o riginal cl aim QPDIS  S CHPDI="" ,CHDOC="", CHBATCH=""  Q:'$D(PDI CPT) Q:PDI CPT="" S J J=999999 S  JJ=$O(@(G LPAY_"PDIC PT,""PDI"" ,JJ)"),-1)  I JJ I $D (@(GLPAY_" PDICPT,""P DI"",JJ,0) ")) D .S C HPDI=$P(@( GLPAY_"PDI CPT,""PDI" ",JJ,0)"), "^",1) .I  CHPDI I $D (^CHMIMG(C HPDI,"DOC" )) S CHDOC =$P(^("DOC "),"^",1)  .I $D(^CHM IMPB("C",C HPDI)) D . .S JJJ=0,J JJ=$O(^CHM IMPB("C",C HPDI,JJJ))  ..I JJJ I  $D(^CHMIM PB(JJJ,0))  S CHBATCH =$P(^(0)," ^",1) QREA SON S RSPT ="" S:$P(@ (GLPAY_"CH PPTR,0)"), "^",13)'=" " RSPT=$P( @(GLPAY_"C HPPTR,0)") ,"^",13) I  RSPT I $D (^CHMDIC(7 41002.22,R SPT,0)) S  CLREAS($P( ^(0),"^",1 ))=$E($P(^ (0),"^",2) ,1,104) ;U SE TO BE L IMITED TO  70 DEV0078 20 BUG PPR 25 EW 8/2/ 12 G:'$D(@ (GLPAY_"CH PPTR,4)"))  RS2 S JJ= 0RS1 S JJ= $O(@(GLPAY _"CHPPTR,4 ,JJ)")) G: 'JJ RS2 S  FIL0="^"_G LPAY_CHPPT R_",4,"_JJ _",0)" G:' $D(@(GLPAY _"CHPPTR,4 ,JJ,0)"))  RS1 S RSPT =$P(@(GLPA Y_"CHPPTR, 4,JJ,0)"), "^",1) I R SPT I $D(^ CHMDIC(741 002.22,RSP T,0)) S CL REAS($P(^( 0),"^",1)) =$E($P(^(0 ),"^",2),1 ,104) ;USE  TO BE LIM ITED TO 70  DEV007820  BUG PPR25  EW 8/2/12  G RS1RS2  W ! G:'$D( CLREAS) RS 4 W !!,"Cl aim Reason s: " S JJ= 0RS3 S JJ= $O(CLREAS( JJ)) G:JJ= "" RS4 W ? 20,JJ," -  ",$E(CLREA S(JJ),1,10 4),! G RS3   ;USE TO  BE LIMITED  TO 53 DEV 007820 BUG  PPR25 EW  8/2/12RS4  Q:'$D(LNRE AS) S JJ=" "RS5 S JJ= $O(LNREAS( JJ)) G:JJ= "" RS6 S T JJ=$P(JJ," *",1),RTNP RO=$P(JJ," *",2) G:'$ D(^CHMDIC( 741002.22, "B",TJJ))  RS5 S RSPT =0,RSPT=$O (^CHMDIC(7 41002.22," B",TJJ,RSP T)) I RSPT  I $D(^CHM DIC(741002 .22,RSPT,0 )) S LIREA S(JJ)=$E($ P(^(0),"^" ,2),1,104)  ;USE TO B E LIMITED  TO 70 DEV0 07820 BUG  PPR25 EW 8 /2/12 G RS 5RS6 Q:'$D (LIREAS) W  !,"Line I tem Reason s: " S JJ= ""RS7 S JJ =$O(LIREAS (JJ)) Q:JJ ="" S TJJ= $P(JJ,"*", 1),REASON1 =$E(LIREAS (JJ),1,104 ) ;USE TO  BE LIMITED  TO 53 DEV 007820 BUG  PPR25 EW  8/2/12 ;// BEG REMARK  OUT REBUN DLING, SKD  3-22-07 D EV000099-0 1// ;I (TJ J=1006)!(T JJ=1007)!( TJJ=1009)  D  ;//END  REMARK OUT  REBUNDLIN G, SKD 3-2 2-07 DEV00 0099-01//  I (TJJ=100 6)!(TJJ=10 07) D   ;T HIS LINE N EEDS TO BE  REPLACED  LATER FOR  REBUNDLING  .K SPEC S  SNTPRO=$P (JJ,"*",2) ,SPEC("XXX XX")=SNTPR O .S REASO N1=$$REPLA CE^XLFSTR( REASON1,.S PEC) K SPE C .S RNTPR O=LNREAS(J J),SPEC("Y YYYY")=RNT PRO .S REA SON1=$$REP LACE^XLFST R(REASON1, .SPEC) K S PEC .S REA SON1=$E(RE ASON1,1,10 4) ;DEV007 820 BUG PP R25 EW 8/2 /12 ;//BEG  REMARK OU T REBUNDLI NG, SKD 3- 22-07 DEV0 00099-01//  ;I TJJ=10 10 D ;SKD  2-21-07 CC 8.5 ;.K SP EC S SNTPR O=$P(JJ,"* ",2),SPEC( "YYYYY")=S NTPRO ;.S  REASON1=$$ REPLACE^XL FSTR(REASO N1,.SPEC)  K SPEC ;// END REMARK  OUT REBUN DLING, SKD  3-22-07 D EV000099-0 1// W ?20, TJJ," - ", REASON1,!  G RS7CHECK S S J=0CHK 1 S J=$O(@ (GLPAY_"CH PPTR,102,J )")) G:'J  CHK2 Q:'$D (@(GLPAY_" CHPPTR,102 ,J,0)")) S  CHECKS($P (@(GLPAY_" CHPPTR,102 ,J,0)"),"^ ",1))="" S :$P(@(GLPA Y_"CHPPTR, 102,J,0)") ,"^",4)=1  CHECKS($P( @(GLPAY_"C HPPTR,102, J,0)"),"^" ,1))=" (Re t)" I $P(@ (GLPAY_"CH PPTR,102,J ,0)"),"^", 8)'="" D . S REDATE=$ P(@(GLPAY_ "CHPPTR,10 2,J,0)")," ^",8) .S R EDATE=$E(R EDATE,4,5) _"/"_$E(RE DATE,6,7)_ "/"_$E(RED ATE,2,3) . S CHECKS($ P(@(GLPAY_ "CHPPTR,10 2,J,0)")," ^",1))=" ( Reis) "_RE DATE G CHK 1CHK2 Q:'$ D(CHECKS)  S CHKNM=""  S TAB=12, LLEN=12 W  !!,"Check  #'s:"CHHK3  S CHKNM=$ O(CHECKS(C HKNM)) Q:C HKNM="" S  LLEN=LLEN+ $L(CHKNM)+ 4+$L(CHECK S(CHKNM))  I LLEN>80  S TAB=12,L LEN=12 W !  W ?TAB,CH KNM,CHECKS (CHKNM) S  TAB=TAB+LL EN G CHHK3
  11  
  12  
  13   Difference s
  14  
  15   See highli ghted info  above.
  16  
  17  
  18   Passed XIN DEX?  (Y /  N):  Y