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.
# | 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 |
Description | Between Files 1 and 2 |
|
---|---|---|
Text Blocks | Lines | |
Unchanged | 1 | 36 |
Changed | 0 | 0 |
Inserted | 0 | 0 |
Removed | 0 | 0 |
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 |
No regular expressions were active.
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 |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.