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

SDSCRP2.m

Go to the documentation of this file. 
  1. SDSCRP2 ;ALB/JAM/RBS - Recovered Costs Report for ASCD ; 3/13/07 2:50pm
  1.  ;;5.3;Scheduling;**495,1015**;Aug 13, 1993;Build 21
  1.  ;;MODIFIED FOR NATIONAL RELEASE from a Class III software product
  1.  ;;known as Service Connected Automated Monitoring (SCAM).
  1.  ;
  1.  ;**Program Description**
  1.  ;  This program will report on all bills generated and amounts
  1.  ;  received for encounters whose Service Connected was changed
  1.  ;  from 'Yes' to 'No'.
  1.  Q
  1. EN ;  Entry point - find all records
  1.  ;  Get Division
  1.  N SDSCDVSL,SDSCDVLN,SDRUN,ZTDESC,ZTRTN,ZTIO,ZTSAVE,DIR,X,Y
  1.  D DIV^SDSCUTL
  1.  D ^DIR
  1.  I $G(DTOUT)!($G(DUOUT)) G EXIT
  1.  S SDSCDVSL=Y,SDSCDVLN=SCLN K DIR,Y,X,SCLN
  1.  S SDRUN=$$HTE^XLFDT($H,1),ZTDESC="RECOVERED COSTS REPORT",ZTRTN="BEG^SDSCRP2"
  1.  ;  Get start and end date for report.
  1.  D GETDATE^SDSCOMP I SDSCTDT="" G EXIT
  1.  W !!,"You will need a 132 column printer for this report!",!
  1.  K %ZIS S %ZIS="QM" D ^%ZIS G EXIT:POP
  1.  I '$D(IO("Q")) K ZTDESC G @ZTRTN
  1.  S ZTIO=ION,ZTSAVE("*")=""
  1.  D ^%ZTLOAD
  1.  G EXIT
  1.  ;
  1. BEG ;  Begin report
  1.  N P,L,SDABRT,CT,SDSCDIV,SDSCDNM,THDR,SDI,DFTOTB,DFTOTP,DTTOTB,DTTOTP
  1.  S (P,L,SDABRT,CT)=0
  1.  S SDSCDIV=$S(SDSCDVSL'[SDSCDVLN:SDSCDVSL,1:"")
  1.  I SDSCDIV="" S SDSCDNM="ALL" D FND G EXT
  1.  I SDSCDIV'="" D
  1.  . S THDR=""
  1.  . F SDI=1:1:$L(SDSCDVSL,",") S SDSCDIV=$P(SDSCDVSL,",",SDI) Q:SDSCDIV=""  D  Q:$G(SDABRT)=1
  1.  .. S SDSCDNM=$P(^DG(40.8,SDSCDIV,0),"^",1),THDR=THDR_SDSCDNM_",",CT=CT+1 D FND
  1.  G EXT
  1.  ;
  1. FND ;  Find records
  1.  N SDATA,SDOEDT,SDOE,DFN,ENCDT,SDCLM,GTOTB,GTOTP,FTOTB,FTOTP,TTOTB,TTOTP
  1.  N BILN,TCHRG,TPAY,AUTHDT,SDWHO,PYMDT,ENCDT,SDSCD,SDPAT,VADM,SCVAL,SDBTR
  1.  K ^TMP($J,"SDSCBILL")
  1.  S SDOEDT=SDSCTDT
  1.  F  S SDOEDT=$O(^SDSC(409.48,"C","C",SDOEDT)) Q:SDOEDT=""!(SDOEDT\1>SDEDT)  D
  1.  . S SDOE=0
  1.  . F  S SDOE=$O(^SDSC(409.48,"C","C",SDOEDT,SDOE)) Q:'SDOE  D
  1.  .. S SDATA=$G(^SDSC(409.48,SDOE,0)) I SDATA="" Q
  1.  .. I $P(SDATA,U,5)'="C" Q
  1.  .. I SDSCDIV'="" Q:$P(SDATA,U,12)'=SDSCDIV
  1.  .. I '+$$GETOE^SDOE(SDOE) Q
  1.  .. ;find only encounters that were changed by ASCD from SC to NSC
  1.  .. S SCVAL=$$SCHNG^SDSCUTL(SDOE) I '+SCVAL Q
  1.  .. I $P(SCVAL,U,3) Q
  1.  .. D FPCK
  1.  .. D TPCK
  1. PRT ;
  1.  U IO D HDR I $G(SDABRT)=1 Q
  1.  S (GTOTB,GTOTP,FTOTB,FTOTP,TTOTB,TTOTP)=0
  1.  I SDSCDIV'="" S DFTOTB(SDSCDNM)=0,DFTOTP(SDSCDNM)=0,DTTOTB(SDSCDNM)=0,DTTOTP(SDSCDNM)=0
  1.  S SDOE=""
  1.  F  S SDOE=$O(^TMP($J,"SDSCBILL","COPAY",SDOE)) Q:SDOE=""  D  Q:$G(SDABRT)=1
  1.  . S BILN=""
  1.  . F  S BILN=$O(^TMP($J,"SDSCBILL","COPAY",SDOE,BILN)) Q:BILN=""  D  Q:$G(SDABRT)=1
  1.  .. S SDBTR=^TMP($J,"SDSCBILL","COPAY",SDOE,BILN)
  1.  .. S TCHRG=$P(SDBTR,U,5)
  1.  .. S TPAY=$P(SDBTR,U,3)
  1.  .. S AUTHDT=$P(SDBTR,U,2)\1
  1.  .. S SDWHO=$$SVCC(SDOE)
  1.  .. S PYMDT=$P(SDBTR,U,4)
  1.  .. S SDSCD=$G(^SDSC(409.48,SDOE,0))
  1.  .. S ENCDT=$P(SDSCD,U,7)\1
  1.  .. S DFN=$P(SDSCD,U,11)
  1.  .. D DEM^VADPT S SDPAT=$E(VADM(1),1,25)_" ("_$E($P(VADM(2),U),6,9)_")"
  1.  .. S GTOTB=GTOTB+TCHRG,GTOTP=GTOTP+TPAY,FTOTB=FTOTB+TCHRG,FTOTP=FTOTP+TPAY
  1.  .. S DFTOTB(SDSCDNM)=$G(DFTOTB(SDSCDNM))+TCHRG,DFTOTP(SDSCDNM)=$G(DFTOTP(SDSCDNM))+TPAY
  1.  .. I L+3>IOSL D HDR Q:$G(SDABRT)=1
  1.  .. W !,SDOE,?10,SDPAT,?45,$$FMTE^XLFDT(ENCDT,"5Z")
  1.  .. W ?60,$$FMTE^XLFDT($P(SDWHO,"^",2),"5Z")
  1.  .. W ?75,$$FMTE^XLFDT(AUTHDT,"5Z"),?90,$$FMTE^XLFDT(PYMDT,"5Z")
  1.  .. W ?105,$J(TCHRG,10,2),?115,$J(TPAY,10,2)
  1.  .. S L=L+1
  1.  I $G(SDABRT)=1 Q
  1.  ;
  1.  I L+6>IOSL D HDR I $G(SDABRT)=1 Q
  1.  W !,$TR($J(" ",IOM)," ","-"),!
  1.  W !,"TOTAL FIRST PARTY: ",?105,$J(FTOTB,10,2),?115,$J(FTOTP,10,2),!!
  1.  S L=L+5
  1.  ;  Print Third Party
  1.  S SDOE=""
  1.  F  S SDOE=$O(^TMP($J,"SDSCBILL","THIRD",SDOE)) Q:SDOE=""  D  Q:$G(SDABRT)=1
  1.  . S BILN=""
  1.  . F  S BILN=$O(^TMP($J,"SDSCBILL","THIRD",SDOE,BILN)) Q:BILN=""  D  Q:$G(SDABRT)=1
  1.  .. S SDBTR=^TMP($J,"SDSCBILL","THIRD",SDOE,BILN)
  1.  .. S TPAY=$P(SDBTR,U,3)
  1.  .. S AUTHDT=$P(SDBTR,U,2)\1
  1.  .. S SDWHO=$$SVCC(SDOE)
  1.  .. S PYMDT=$P(SDBTR,U,4)
  1.  .. S SDSCD=$G(^SDSC(409.48,SDOE,0))
  1.  .. S ENCDT=$P(SDSCD,U,7)\1
  1.  .. S DFN=$P(SDSCD,U,11)
  1.  .. D DEM^VADPT S SDPAT=$E(VADM(1),1,25)_" ("_$E($P(VADM(2),U),6,9)_")"
  1.  .. S TCHRG=$P(SDBTR,U)
  1.  .. S GTOTB=GTOTB+TCHRG,GTOTP=GTOTP+TPAY,TTOTB=TTOTB+TCHRG,TTOTP=TTOTP+TPAY
  1.  .. S DTTOTB(SDSCDNM)=$G(DTTOTB(SDSCDNM))+TCHRG,DTTOTP(SDSCDNM)=$G(DTTOTP(SDSCDNM))+TPAY
  1.  .. I L+3>IOSL D HDR Q:$G(SDABRT)=1
  1.  .. W !,SDOE,?10,SDPAT,?45,$$FMTE^XLFDT(ENCDT,"5Z")
  1.  .. W ?60,$$FMTE^XLFDT($P(SDWHO,"^",2),"5Z")
  1.  .. W ?75,$$FMTE^XLFDT(AUTHDT,"5Z"),?90,$$FMTE^XLFDT(PYMDT,"5Z")
  1.  .. W ?105,$J(TCHRG,10,2),?115,$J(TPAY,10,2)
  1.  .. S L=L+1
  1.  I $G(SDABRT)=1 Q
  1.  ;
  1.  I L+6>IOSL D HDR I $G(SDABRT)=1 Q
  1.  W !,$TR($J(" ",IOM)," ","-"),!
  1.  W !,"TOTAL THIRD PARTY: ",?105,$J(TTOTB,10,2),?115,$J(TTOTP,10,2),!!
  1.  S L=L+5
  1.  I L+6>IOSL D HDR I $G(SDABRT)=1 Q
  1.  W !,$TR($J(" ",IOM)," ","-"),!
  1.  W !,"TOTAL FOR BOTH: ",?105,$J(GTOTB,10,2),?115,$J(GTOTP,10,2),!!
  1.  S L=L+5
  1.  Q
  1.  ;
  1. FPCK ;Check for First Party Bill
  1.  N SCBLNS,SCARTR
  1.  S SCBLNS=$$FPBILL^IBRSUTL(SDOE) I (SCBLNS="")!($P(SCBLNS,U))="" Q
  1.  S SCARTR=$$GETDATA^PRCAAPI($P(SCBLNS,U)) I SCARTR="" Q
  1.  S $P(SCARTR,U,5)=$P(SCBLNS,U,3)
  1.  S ^TMP($J,"SDSCBILL","COPAY",SDOE,$P(SCBLNS,U))=SCARTR
  1.  Q
  1.  ;
  1. TPCK ;Check for Third Party Bill
  1.  N SCBLNS,SCBID,SCARTR,SCI
  1.  S SCBLNS=$$TPBILL^IBRSUTL(SDOE) I SCBLNS="" Q
  1.  F SCI=1:1 S SCBID=$P(SCBLNS,U,SCI) Q:SCBID=""  D
  1.  . S SCARTR=$$GETDATA^PRCAAPI(SCBID)
  1.  . I SCARTR="" Q
  1.  . S ^TMP($J,"SDSCBILL","THIRD",SDOE,SCBID)=SCARTR
  1.  Q
  1.  ;
  1. HDR ; Header
  1.  ; Do not ask 'RETURN' before first page on CRT.
  1.  I $E(IOST,1,2)="C-",P D  I 'Y S SDABRT=1 Q
  1.  .N DIR S DIR(0)="E" D ^DIR
  1.  ; Do not print a form feed before first page on printer. Top of form is set at end of previous report.
  1.  I $E(IOST,1,2)="C-"!P W @IOF
  1.  S P=P+1,L=4
  1.  W "Recovered Costs Report by Division: "_SDSCDNM_" ",?90,"Run Date: ",SDRUN,?124,"Page ",$J(P,3)
  1.  W !,"Enc #",?10,"Patient",?45,"Enc Date",?60,"Change Date",?75,"Auth Date",?90,"Pay Date",?105,"Prncpl Bill",?117,"Prncpl Pay"
  1.  W !,$TR($J(" ",IOM)," ","-"),!
  1.  Q
  1.  ;
  1. EXT ;
  1.  N L,TOTALB,TOTALP,DIV
  1.  I CT>1,$G(SDABRT)'=1 D
  1.  . I $E(IOST,1,2)="C-",P N DIR S DIR(0)="E" D ^DIR I 'Y S SDABRT=1 Q
  1.  . ; Do not print a form feed before first page on printer. Top of form is set at end of previous report.
  1.  . I $E(IOST,1,2)="C-"!P W @IOF
  1.  . S P=P+1,L=4,TOTALB=0,TOTALP=0
  1.  . I $E(THDR,$L(THDR))="," S THDR=$E(THDR,1,$L(THDR)-1)
  1.  . W "Recovered Costs Report",?90,"Run Date: ",SDRUN,?124,"Page ",$J(P,3)
  1.  . W !,"By Division(s) "_THDR
  1.  . W !,?105,"Prncpl Bill",?117,"Prncpl Pay"
  1.  . W !,$TR($J(" ",IOM)," ","-"),!
  1.  . W !,?10,"FIRST PARTY TOTAL"
  1.  . S DIV="" F  S DIV=$O(DFTOTB(DIV)) Q:DIV=""  D
  1.  .. W !,?30,DIV,?105,$J(DFTOTB(DIV),10,2),?115,$J(DFTOTP(DIV),10,2)
  1.  .. S TOTALB=TOTALB+DFTOTB(DIV),TOTALP=TOTALP+DFTOTP(DIV)
  1.  . W !,$TR($J(" ",IOM)," ","-"),!
  1.  . W !,?10,"THIRD PARTY TOTAL"
  1.  . S DIV="" F  S DIV=$O(DTTOTB(DIV)) Q:DIV=""  D
  1.  .. W !,?30,DIV,?105,$J(DTTOTB(DIV),10,2),?115,$J(DTTOTP(DIV),10,2)
  1.  .. S TOTALB=TOTALB+DTTOTB(DIV),TOTALP=TOTALP+DTTOTP(DIV)
  1.  . W !,$TR($J(" ",IOM)," ","-"),!
  1.  . W !,?10,"TOTAL FOR BOTH FIRST AND THIRD PARTY",?105,$J(TOTALB,10,2),?115,$J(TOTALP,10,2)
  1.  D RPTEND^SDSCRPT1
  1.  ;
  1. EXIT ; Exit tag
  1.  K SDQFL,SDRUN,SDEDT,SDOE,SDOEDT,SDSCTDT,SDSCBDT,SDSCEDT,POP,SDABRT,BILL
  1.  K BILT,FIND,DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y,SCLN D KVA^VADPT
  1.  K ^TMP($J,"SDSCBILL")
  1.  Q
  1.  ;
  1. SVCC(SDENC) ; Service Connected Last Edit Change
  1.  ;
  1.  ;  Input:
  1.  ;    SDENC = Encounter IEN
  1.  ;
  1.  ;  Output:
  1.  ;    Function = "" - (null if undefined)
  1.  ;             = EDITED BY_"^"_DATE EDITED  - (WHO^WHEN)
  1.  ;
  1.  N SDJ,SDVAL,SDX
  1.  S SDVAL="",SDJ=999999
  1.  S SDJ=$O(^SDSC(409.48,SDENC,1,SDJ),-1)
  1.  I SDJ D
  1.  . S SDX=$G(^SDSC(409.48,SDENC,1,SDJ,0))
  1.  . I $P(SDX,U,5)=0 D
  1.  . . S SDVAL=$P(SDX,U,3)_"^"_$P(SDX,U,2)
  1.  Q SDVAL