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

RMPORMB.m

Go to the documentation of this file. 
  1. RMPORMB ;HIN/RVD - Home Oxygen Monthly Billing Report ;12/13/99
  1.  ;;3.0;PROSTHETICS;**29,43,44,49,55,159,179**;Feb 09, 1996;Build 7
  1.  ;ODJ - 5/17/00 - fix FCP problem (patch 49)
  1.  ;      5/25/00 - fix crash if FCP in ^RMPO(665.72) and not ^RMPR(669.9)
  1.  ;      5/31/00 - fix crash if FCP is null
  1.  ;
  1.  ;ODJ - 10/31/00 - patch 55 - fix problem where totals not being
  1.  ;                            displayed when page contains 16 pats.
  1.  ;
  1.  ;RMPR*3.0*179 Flag a deceased patient by adding an '*'
  1.  ;             in front of SSN. 
  1.  ;
  1. START ;
  1.  K RQUIT,RSP,RCNT,RPAGE,RDASH,RPTDT,RSHODT,VA,VADM,DFN,RNAM,RMNADFN
  1.  K Y,RAMT,RLINE,ROVNDR,^TMP($J),RMEND,QUIT
  1.  ;
  1. SITE ;Intialize site variables.
  1.  D HOSITE^RMPOUTL0 I '$D(RMPOXITE) Q
  1.  ;
  1. FROM ; Get billing month
  1.  ; specify start/end site & bill month
  1.  D MONTH^RMPOBIL0() Q:'$D(RMPODATE)!QUIT
  1. DEV S %ZIS="MQ" K IOP D ^%ZIS G:POP EXIT I '$D(IO("Q")) U IO G PROC
  1.  K IO("Q") S ZTDESC="HOME OXYGEN MONTHLY BILLING",ZTRTN="PROC^RMPORMB",ZTIO=ION,ZTSAVE("RMPODATE")="",ZTSAVE("RMPO(""STA"")")="",ZTSAVE("RMPOXITE")=""
  1.  S ZTSAVE("RMPO(""NAME"")")=""
  1.  D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED!" H 1 G EXIT
  1. PROC ;
  1.  S (RPAGE,RMEND,RMPORPT,RVCNT,RPCNT,RVPRCNT,RMPODCNT)=0    ;RMPR*3.0*179
  1.  S Y=RMPODATE D DD^%DT S RSHODT=Y
  1.  S $P(RSP," ",79)=" ",RCNT=0,$P(RDASH,"-",80)=""
  1.  D NOW^%DTC S Y=% X ^DD("DD")
  1.  S RPTDT=$P(Y,"@",1)_"  "_$P($P(Y,"@",2),":",1,2)
  1.  F I="T9","TS","TO","SP",1,2,3 S RAMT(I)=0
  1.  K RFCPT S RFCPI=""
  1.  F  S RFCPI=$O(^RMPR(669.9,RMPOXITE,"RMPOFCP","B",RFCPI)) Q:RFCPI=""  D
  1.  . S RFCPIEN=$O(^RMPR(669.9,RMPOXITE,"RMPOFCP","B",RFCPI,0))
  1.  . S RPSASFLG=$P(^RMPR(669.9,RMPOXITE,"RMPOFCP",RFCPIEN,0),U,2)
  1.  . ;S RFCPT(RFCPI)=$S(+RFCPI=910:1,RPSASFLG="Y":2,1:3)
  1.  . ;p49 replaces above logic - if PSAS then col 1 else col 2
  1.  . S RFCPT(RFCPI)=$S(RPSASFLG="Y":1,1:2)
  1.  . Q
  1.  D LINE
  1.  D PRINT G:$G(RMEND) EXIT
  1.  I $E(IOST)["C",(RVCNT=1),(RVPRCNT=1) D  ; if terminal
  1.  .K DIR S DIR("A")="Enter RETURN to continue or '^' to QUIT",DIR(0)="E"
  1.  .D ^DIR S:$G(X)[U RMEND=1
  1. EXIT ;clean-up local variables and close device
  1.  D ^%ZISC K ^TMP($J)
  1.  N RMPR,RMPRSITE D KILL^XUSCLEAN
  1.  Q
  1.  ;
  1. NAME ;Write out the name
  1.  S RLINE=RLINE_$E($P(RNAM,U,1)_RSP,1,14)
  1.  S RLINE=RLINE_$E($P(RNAM,U,2)_RSP,1,6)
  1.  Q
  1.  ;
  1. LINE ;Process entire line (one for each patient)
  1.  W:$E(IOST)["C" "processing..."
  1.  F RV=0:0 S RV=$O(^RMPO(665.72,RMPOXITE,1,RMPODATE,1,RV)) Q:RV'>0  D SETRV F RN=0:0 S RN=$O(^RMPO(665.72,RMPOXITE,1,RMPODATE,1,RV,"V",RN)) Q:RN'>0  D
  1.  . S RMPOEXP=" " I +$G(^DPT(RN,.35)) S RMPOEXP="*",RMPODCNT=RMPODCNT+1    ;RMPR*3.0*179 Flag a deceased patient by attaching an '*' to SSN. ^DPT(D0,.35) direct read supported by ICR #10035
  1.  .K VA,VADM S DFN=RN D ^VADPT
  1.  .S RNAM=$E(VADM(1),1,12)_"^"_$P(VA("PID"),"-",3)_RMPOEXP    ;RMPR*3.0*179
  1.  .S RACPT=$P(^RMPO(665.72,RMPOXITE,1,RMPODATE,1,RV,"V",RN,0),U,2)
  1.  .S RPSTD=$P(^RMPO(665.72,RMPOXITE,1,RMPODATE,1,RV,"V",RN,0),U,3)
  1.  .S RAMT(RV,1)=0,RAMT(RV,2)=0,RAMT(RV,3)=0,RAMT(RV,"SUSP")=0
  1.  .F RI=0:0 S RI=$O(^RMPO(665.72,RMPOXITE,1,RMPODATE,1,RV,"V",RN,1,RI)) Q:RI'>0  D
  1.  ..S RD=^RMPO(665.72,RMPOXITE,1,RMPODATE,1,RV,"V",RN,1,RI,0)
  1.  ..S RCOST=$P(RD,U,5),RTOTAL=$P(RD,U,6),RFCP=$P(RD,U,3),RSUSP=$P(RD,U,11)
  1.  ..S:RFCP="" RFCP="???"
  1.  ..I '$D(RFCPT(RFCP)) S RFCPT(RFCP)=2 ;p49 fix problem where FCP not in site file ^RMPR(669.9) (use the OTHER col. in this case)
  1.  ..S RX=RFCPT(RFCP),RAMT(RV,RX)=$G(RAMT(RV,RX))+RTOTAL,RAMT(RV,"SUSP")=$G(RAMT(RV,"SUSP"))+RSUSP
  1.  .S RLINE=$S(RACPT="Y":"a",1:" ")_$S(RPSTD="Y":"#",RPSTD="P":"p",1:" ")
  1.  .S RLINE=$E(RLINE_RSP,1,4) D NAME
  1.  .S RLINE=RLINE_$E($P(^PRC(440,RV,0),U)_RSP,1,8)_" "
  1.  .S RMT1=$G(RAMT(RV,1))
  1.  .S RMT2=$G(RAMT(RV,2))
  1.  .S RMT3=$G(RAMT(RV,3))
  1.  .S RMTP=$G(RAMT(RV,"SUSP"))
  1.  .D AMTS(RMT1,RMT2,RMT3,RMTP)
  1.  .S RTMT(RV,"T9")=RTMT(RV,"T9")+RMT1,RTMT(RV,"TS")=RTMT(RV,"TS")+RMT2
  1.  .S RTMT(RV,"TO")=RTMT(RV,"TO")+RMT3,RTMT(RV,"SP")=RTMT(RV,"SP")+RMTP
  1.  .S RMNADFN=RNAM_"^"_RN,^TMP($J,RV,RMNADFN)=RLINE
  1.  Q
  1.  ;
  1. PRINT ;print report
  1.  I '$D(^TMP($J)) W !,"***** No RECORDS to Print *****" Q 
  1.  S (RVPRCNT,RPCNT,RCNT)=0
  1.  F RV=0:0 S RV=$O(^TMP($J,RV)) Q:RV'>0!($G(RMEND))  D RPTHDR S RN="" F  S RN=$O(^TMP($J,RV,RN)) Q:$G(RMEND)  D:RN="" DND Q:RN=""  D
  1.  .W !,$G(^TMP($J,RV,RN)) S RPCNT=RPCNT+1,RCNT=RCNT+1 D:IOSL<(RCNT+9) PAGE Q:$G(RMEND)
  1.  D GTOTAL
  1.  Q
  1.  ;
  1. SETRV ;
  1.  F I=1,2,3 S RAMT(RV,I)=0
  1.  F I="T9","TS","TO","SP" S RTMT(RV,I)=0
  1.  S RVCNT=RVCNT+1
  1.  Q
  1.  ;
  1. AMTS(C,Y,Z,S) ; Amounts
  1.  S RLINE=RLINE_$E($$AMT(C)_RSP,1,9)
  1.  S RLINE=RLINE_$E($$AMT(Y)_RSP,1,9)
  1.  S RLINE=RLINE_$E($$AMT(Z)_RSP,1,9)
  1.  S RLINE=RLINE_$E($$AMT(S)_RSP,1,9)
  1.  S RLINE=RLINE_" "_$$AMT(C+Y+Z)
  1.  Q
  1. AMT(C) ; Format Amounts
  1.  I C,C'["." S C=+C_".00"
  1.  I C?.N1"."1N  S C=C_0
  1.  S:C=0 C="-" S C=$E("     ",1,8-$L(C))_C
  1.  Q C
  1.  ;
  1. PAGE ;Print page
  1.  I $E(IOST)["C",IOSL<(RCNT+9) D  ; if terminal
  1.  . K DIR S DIR("A")="Enter RETURN to continue or '^' to QUIT",DIR(0)="E"
  1.  . D ^DIR S:$G(X)[U RMEND=1
  1.  D:'$G(RMEND) RPTHDR
  1.  Q
  1. RPTHDR ; Print out the report header
  1.  Q:$G(RMEND)  K RA
  1.  S RA=RMPO("NAME"),RPAGE=RPAGE+1,RCNT=0
  1.  I $E(IOST)["C"!(RPAGE>1) W @IOF
  1.  W RPTDT,?(40-($L(RA)/2)),RA,?68,"Page: "_RPAGE
  1.  W !?10,RSHODT_" Monthly Home Oxygen Billing",?50,"'*' denotes deceased patient",!
  1.  W ?45,"Station",!?45,"Fund Control"
  1.  W !,"ACC",?4,"Name",?18,"SSN",?24,"Vendor"
  1.  W ?37,"910     Point     Other    Susp     Total"
  1.  W !,RDASH
  1.  Q
  1.  ;
  1. DND ; Print REPORT totals
  1.  Q:$G(RMEND)  K RA
  1.  S RLINE="     ",RA=RTMT(RV,"T9")+RTMT(RV,"TS")+RTMT(RV,"TO")-RTMT(RV,"SP")
  1.  I RA D
  1.  . S RMTT9=RTMT(RV,"T9"),RMTTS=RTMT(RV,"TS"),RMTTO=RTMT(RV,"TO")
  1.  . S RMTSP=RTMT(RV,"SP")
  1.  . D AMTS(RMTT9,RMTTS,RMTTO,RMTSP)
  1.  . W !,?20,"Totals: ",RLINE
  1.  S RPCNT=$E("  ",1,(6-$L(RPCNT)))_RPCNT
  1.  W !!,?29,"Total Patients: ",RPCNT
  1.  S RMPODCNT=$E("  ",1,(6-$L(RMPODCNT)))_RMPODCNT
  1.  W !!,?20,"Total Deceased Patients: ",RMPODCNT
  1.  S RVPRCNT=RVPRCNT+1,RPCNT=0
  1.  I $E(IOST)["C",(RVCNT'=RVPRCNT) D  ; if terminal
  1.  .K DIR S DIR("A")="Enter RETURN to continue or '^' to QUIT",DIR(0)="E"
  1.  .D ^DIR S:$G(X)[U RMEND=1
  1.  Q
  1.  ;
  1. GTOTAL ; Print REPORT totals for all VENDORS.
  1.  Q:$G(RMEND)  K RA
  1.  ;S RLINE="     ",RA=RTMT(RV,"T9")+RTMT(RV,"TS")+RTMT(RV,"TO")-RTMT(RV,"SP")
  1.  S RLINE="     "
  1.  S (RMTT9,RMTTS,RMTTO,RMTSP)=0
  1.  I RVCNT>1 D
  1.  .F RI=0:0 S RI=$O(RTMT(RI)) Q:RI'>0  D
  1.  .. S RMTT9=RMTT9+RTMT(RI,"T9"),RMTTS=RMTTS+RTMT(RI,"TS"),RMTTO=RMTTO+RTMT(RI,"TO")
  1.  .. S RMTSP=RMTSP+RTMT(RI,"SP")
  1.  .D AMTS(RMTT9,RMTTS,RMTTO,RMTSP)
  1.  .W !!,?14,"Grand Totals: ",RLINE,!
  1.  .I $E(IOST)["C" D  ; if terminal
  1.  ..K DIR S DIR("A")="Enter RETURN to continue or '^' to QUIT",DIR(0)="E"
  1.  ..D ^DIR S:$G(X)[U RMEND=1
  1.  Q