Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RCXFMSPR

RCXFMSPR.m

Go to the documentation of this file.
  1. RCXFMSPR ;WISC/RFJ-print revenue source codes ;8/31/10 11:34am
  1. ;;4.5;Accounts Receivable;**90,96,101,156,170,203,273,310,315,338,351,357**;Mar 20, 1995;Build 6
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. W !,"This option will print out a list of the revenue source codes sent from"
  1. W !,"the VISTA system to FMS."
  1. ;
  1. ; select device
  1. W ! S %ZIS="Q" D ^%ZIS Q:POP
  1. I $D(IO("Q")) D D ^%ZTLOAD K IO("Q"),ZTSK Q
  1. . S ZTDESC="Revenue Source Code Report",ZTRTN="DQ^RCXFMSPR"
  1. . S ZTSAVE("ZTREQ")="@"
  1. W !!,"<*> please wait <*>"
  1. ;
  1. DQ ; queue starts here
  1. N %,%I,BINARY,COL2DESC,COL3DESC,COLUMN1,COLUMN2,COLUMN3,COLUMN4
  1. N DECIMAL,DESCRIP,NOW,PAGE,RCSTFLAG,SCREEN,X,Y
  1. D NOW^%DTC S Y=% D DD^%DT S NOW=Y
  1. S PAGE=1,SCREEN=0 I '$D(ZTQUEUED),IO=IO(0),$E(IOST)="C" S SCREEN=1
  1. U IO D H
  1. ;
  1. S COLUMN1="A",COLUMN2="R",COLUMN3="R",COLUMN4="V",DESCRIP="Miscellaneous"
  1. D WRITEIT
  1. ;
  1. ; for now, column 1 is always 8 and column 4 is always Z
  1. S COLUMN1=8,COLUMN4="Z"
  1. F COLUMN2=1:1:9,"A","B","C","D","E","F","G","H","I","J","K","L","M","Q","R","S","T" D Q:$G(RCSTFLAG)
  1. . S COL2DESC=$P($T(@("A"_COLUMN2)),";",3)
  1. . ;
  1. . S COLUMN3=$S(COLUMN2=5:"*",1:"Z")
  1. . S DESCRIP=COL2DESC D WRITEIT
  1. . ;
  1. . I $G(RCSTFLAG) Q
  1. . ;
  1. . ; show hsif - disabled by patch 203
  1. . ;I COLUMN2="B"!(COLUMN2="C") S DESCRIP=DESCRIP_" HSIF",COLUMN3=1 D WRITEIT
  1. ;
  1. I $G(RCSTFLAG) D Q Q
  1. ;
  1. ; print reimbursable health insurance rsc's
  1. S COLUMN2=5
  1. W !!?6,"For REIMBURSABLE HEALTH INSURANCE [85*Z]:"
  1. F DECIMAL=0:1:31 D Q:$G(RCSTFLAG)
  1. . I DECIMAL<10 S COLUMN3=DECIMAL
  1. . E S COLUMN3=$C(65+DECIMAL-10)
  1. . ;
  1. . ; convert decimal to binary (ex: 10011) so it can be
  1. . ; parsed in rsc to get the description
  1. . S BINARY=$$CONVERT(DECIMAL)
  1. . S COL3DESC=$P($T(@("B"_$E(BINARY,1,2))),";",3)
  1. . S COL3DESC=COL3DESC_", "_$P($T(@("C"_$E(BINARY,3))),";",3)
  1. . S COL3DESC=COL3DESC_", "_$P($T(@("D"_$E(BINARY,4))),";",3)
  1. . S COL3DESC=COL3DESC_", "_$P($T(@("E"_$E(BINARY,5))),";",3)
  1. . S DESCRIP=COL3DESC
  1. . D WRITEIT
  1. ;
  1. ; print fee basis reimbursable health insurance rsc's (PRCA*4.5*310/DRF)
  1. S COLUMN2="F"
  1. W !!?6,"For FEE REIMBURSABLE HEALTH INSURANCE [8F*Z]:"
  1. F DECIMAL=1:1:2 D Q:$G(RCSTFLAG)
  1. . S DESCRIP="FEE BASIS, NSC VET, MT CAT A, "_$S(DECIMAL=1:"INPATIENT",DECIMAL=2:"OUTPATIENT",1:"")
  1. . S COLUMN3=DECIMAL
  1. . D WRITEIT
  1. ;
  1. ; print EMERGENCY/HUMANITARIAN REIMB. PRCA*4.5*315
  1. ; 8VZZ;HUMAN 3RD-PRTY OUTPATIENT
  1. ; 8UZZ;HUMAN 3RD-PRTY INPATIENT
  1. S COLUMN3="Z"
  1. W !!?6,"For EMERGENCY/HUMANITARIAN REIMBURSABLE HEALTH INSURANCE [8*ZZ]:"
  1. F DECIMAL="U","V" D Q:$G(RCSTFLAG)
  1. . S DESCRIP="EMERGENCY/HUMANITARIAN REIMB. INS., "_$S(DECIMAL="U":"INPATIENT",DECIMAL="V":"OUTPATIENT",1:"")
  1. . S COLUMN2=DECIMAL
  1. . D WRITEIT
  1. ;
  1. Q D ^%ZISC
  1. ; print CCAD rsc's (PRCA*4.5*338)
  1. N DATA,LOOP
  1. S (COLUMN2,COLUMN3,COLUMN4)="" ;Clear other columns
  1. W !!?6,"For COMMUNITY CARE:"
  1. F LOOP=1:1 S DATA=$T(CCADRSC+LOOP) Q:(DATA="")!($P(DATA,";",3)="END") D Q:$G(RCSTFLAG)
  1. . S COLUMN1=$P(DATA,";",3),DESCRIP=$P(DATA,";",4)
  1. . D WRITEIT
  1. Q
  1. ;
  1. ;
  1. GETDESC(RSC) ; return the description for the revenue source code
  1. N BINARY,COL3DESC,COLUMN2,COLUMN3,DESC,RCARY
  1. ;new resource codes for emergency/humanitarian reimb. PRCA*4.5*315
  1. I RSC="8UZZ" Q "Emergency/Humanitarian Reimb. Ins., Inpatient"
  1. I RSC="8VZZ" Q "Emergency/Humanitarian Reimb. Ins., Outpatient"
  1. I RSC="ARRV" Q "Miscellaneous"
  1. I RSC=8046 Q "Administrative"
  1. I RSC=8047 Q "Interest"
  1. I RSC=8048 Q "Marshal Fee and Court Cost"
  1. ;PRCA*4.5*338 - check to see if RSC is a Community Care RSC and add RSCs missing a description.
  1. I RSC=8000 Q "Non Medical Reimbursements"
  1. I RSC=8023 Q "Compensated Work Therapy"
  1. I RSC=8024 Q "Tort Feasor"
  1. I RSC=8041 Q "FED OWCP"
  1. F LOOP=1:1 S DATA=$T(CCADRSC+LOOP) Q:(DATA="")!($P(DATA,";",3)="END") D
  1. . S RCARY($P(DATA,";",3))=$P(DATA,";",4)
  1. I $G(RCARY(RSC))'="" Q $G(RCARY(RSC))
  1. ;end PRCA*4.5*338
  1. S DESC="UNKNOWN"
  1. S COLUMN2=$E(RSC,2)
  1. I "123456789ABCDEFGHIJKLMNQRST"[COLUMN2 S DESC=$P($T(@("A"_COLUMN2)),";",3) ;PRCA*4.5*357
  1. ; HSIF reference disabled by patch 203
  1. ; I RSC="8B1Z"!(RSC="8C1Z") S DESC=DESC_" (HSIF)"
  1. I COLUMN2'=5 Q DESC
  1. ;
  1. S COLUMN3=$E(RSC,3)
  1. ; convert alpha letters to decimal
  1. I "0123456789"'[COLUMN3 S COLUMN3=$A(COLUMN3)-55
  1. S BINARY=$$CONVERT(COLUMN3)
  1. S COL3DESC=$P($T(@("B"_$E(BINARY,1,2))),";",3)
  1. S COL3DESC=COL3DESC_", "_$P($T(@("C"_$E(BINARY,3))),";",3)
  1. S COL3DESC=COL3DESC_", "_$P($T(@("D"_$E(BINARY,4))),";",3)
  1. S COL3DESC=COL3DESC_", "_$P($T(@("E"_$E(BINARY,5))),";",3)
  1. Q "RHI, "_COL3DESC
  1. ;
  1. ;
  1. CONVERT(DECIMAL) ; convert decimal number to binary (5 digits)
  1. N Y
  1. S Y=""
  1. F S Y=$E("0123456789ABCDEF",DECIMAL#2+1)_Y,DECIMAL=DECIMAL\2 Q:DECIMAL<1
  1. S Y=$E("00000",0,5-$L(Y))_Y
  1. Q Y
  1. ;
  1. ;
  1. WRITEIT ; display the rsc
  1. W !,COLUMN1,COLUMN2,COLUMN3,COLUMN4,?6,DESCRIP
  1. I $Y>(IOSL-5) D:SCREEN PAUSE Q:$G(RCSTFLAG) D H
  1. Q
  1. ;
  1. ;
  1. PAUSE ; pause at end of page
  1. N X U IO(0) W !,"Press RETURN to continue, '^' to exit:" R X:DTIME S:'$T X="^" S:X["^" RCSTFLAG=1 U IO
  1. Q
  1. ;
  1. ;
  1. H ; header
  1. S %=NOW_" PAGE "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF
  1. W $C(13),"REVENUE SOURCE CODE REPORT (VISTA TO FMS)",?(80-$L(%)),%
  1. W !,"RSC",?6,"Description"
  1. S %="",$P(%,"-",81)=""
  1. W !,%
  1. Q
  1. ;
  1. ;
  1. ; this is a listing of all column2 values with a description
  1. A1 ;;Hospital Care (NSC)
  1. A2 ;;Outpatient Care (NSC)
  1. A3 ;;Nursing Home Care (NSC)
  1. A4 ;;Ineligible Hospitalization
  1. A5 ;;Reimbursable Health Insurance
  1. A6 ;;Tort Feasor
  1. A7 ;;Workmans Compensation (Non-Federal)
  1. A8 ;;C (Means Test)
  1. A9 ;;Emergency/Humanitarian
  1. AA ;;No Fault Auto Accident
  1. AB ;;Pharmacy Co-Pay (SC Vet)
  1. AC ;;Pharmacy Co-Pay (NSC Vet)
  1. AE ;;Hospital Care Per Diem
  1. AF ;;Medicare
  1. AG ;;Adult Day Health Care (LTC)
  1. AH ;;Domiciliary (LTC)
  1. AI ;;Respite Care-Institutional (LTC)
  1. AJ ;;Respite Care-Non-Institutional (LTC)
  1. AK ;;Geriatric Eval-Institutional (LTC)
  1. AL ;;Geriatric Eval-Non-Institutional (LTC)
  1. AM ;;Nursing Home Care-Long Term Care (LTC)
  1. AN ;;EDI 3RD PARTY LOCKBOX
  1. AQ ;;Pharmacy No Fault Auto Acc
  1. AR ;;Pharmacy Reimburs Health Ins
  1. AS ;;Pharmacy Tort Feasor
  1. AT ;;Pharmacy Workman's Comp
  1. ;
  1. ;
  1. ; this is a listing for the type of care, first 2 binary digits
  1. ; if column2 is reimbursable health insurance
  1. B00 ;;Inpatient (Hosp)
  1. B01 ;;Outpatient
  1. B10 ;;Nursing Home
  1. B11 ;;Other
  1. ;
  1. ;
  1. ; this is a listing for the service connected, binary digit 3
  1. C0 ;;SC for NSC
  1. C1 ;;NSC Vet
  1. ;
  1. ;
  1. ; this is a listing for means test, binary digit 4
  1. D0 ;;MT Cat A
  1. D1 ;;MT Cat C
  1. ;
  1. ;
  1. ; this is a listing for age group, binary digit 5
  1. E0 ;;Age <65
  1. E1 ;;Age 65+
  1. ;
  1. ;
  1. ; Community Care RSC listing PRCA*4.5*338
  1. CCADRSC ;;
  1. ;;8C6C;CC 3rd-Pty Workers' Comp
  1. ;;8C5C;CC 3rd-Pty Tort Feasor
  1. ;;8C4C;CC 3rd-Pty No-Fault Auto
  1. ;;8C1C;CC 3rd-Pty Inpatient
  1. ;;8C2C;CC 3rd-Pty Outpatient
  1. ;;8C3C;CC 3rd-Pty RX
  1. ;;86CC;CC Choice 3rd-Pty Workers' Comp
  1. ;;85CC;CC Choice 3rd-Pty Tort Feasor
  1. ;;84CC;CC Choice 3rd-Pty No-Fault Auto
  1. ;;81CC;CC Choice 3rd-Pty Inpatient
  1. ;;82CC;CC Choice 3rd-Pty Outpatient
  1. ;;83CC;CC Choice 3rd-Pty RX
  1. ;;8CD4;CC DOD 3rd-Pty Inpatient
  1. ;;8CD5;CC DOD 3rd-Pty Outpatient
  1. ;;8CD6;CC DOD 3rd-Pty RX
  1. ;;8CNW;CCN 3rd-Pty Workers' Comp
  1. ;;8CN9;CCN 3rd-Pty Tort Feasor
  1. ;;8CN8;CCN 3rd-Pty No-Fault Auto
  1. ;;8CN5;CCN 3rd-Pty Inpatient
  1. ;;8CN6;CCN 3rd-Pty Outpatient
  1. ;;8CN7;CCN 3rd-Pty RX
  1. ;;8CC1;CC 1st-Pty Inpatient
  1. ;;8CC2;CC 1st-Pty Outpatient
  1. ;;8CC3;CC 1st-Pty RX
  1. ;;8CC4;CC 1st-Pty LTC
  1. ;;8CC5;CC Choice 1st-Pty Inpatient
  1. ;;8CC6;CC Choice 1st-Pty Outpatient
  1. ;;8CC7;CC Choice 1st-Pty RX
  1. ;;8CC8;CC Choice 1st-Pty LTC
  1. ;;8CN1;CCN 1st-Pty Inpatient
  1. ;;8CN2;CCN 1st-Pty Outpatient
  1. ;;8CN3;CCN 1st-Pty RX
  1. ;;8CN4;CCN 1st-Pty LTC
  1. ;;8CD1;CC DOD 1st-Pty Inpatient
  1. ;;8CD2;CC DOD 1st-Pty Outpatient
  1. ;;8CD3;CC DOD 1st-Pty RX
  1. ;;8CCU;CC 1st-Pty Urgent Care
  1. ;;END