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

RMPORAP.m

Go to the documentation of this file.
  1. RMPORAP ;(NG)/DG/CAP - ACTIVE HOME OXY PTS IN ZIP CODE ORDER ;7/24/98
  1. ;;3.0;PROSTHETICS;**29,179**;Feb 09, 1996;Build 7
  1. ;
  1. ;RMPR*3.0*179 Flag a deceased patient by adding an '*'
  1. ; in front of SSN.
  1. ;
  1. SITE ;Initialize site variables.
  1. D HOSITE^RMPOUTL0 I '$D(RMPOXITE) Q
  1. ;
  1. LI ;List sought patients.
  1. N WHO S (WHO,COUNT,RMEND,RMPOPRT,RMPODCNT)=0 ;RMPR*3.0*179
  1. S DIC="^RMPR(665,"
  1. S DIS(0)="I $P($G(^RMPR(665,D0,""RMPOA"")),U,7)=RMPOXITE,$P($G(^RMPR(665,D0,""RMPOA"")),U,3)="""""
  1. S BY="[RMPO-RPT-HOACTZIPLIST]"
  1. S FR="",PAGE=0
  1. S FLDS="[RMPO-RPT-HOACTZIPLIST]"
  1. S DHD="W ?0 D RPTHDR^RMPORAP"
  1. S DHIT="D CNT^RMPORAP"
  1. S DIOEND="I $G(Y)'[U D DIOEND^RMPORAP S RMEND=1 S:IOST[""P-"" RMPOPRT=1" ;RMPR*3.0*179
  1. D EN1^DIP
  1. I RMPOPRT=0,$G(RMEND) K DIR S DIR(0)="E" D ^DIR
  1. D EXIT
  1. Q
  1. ;
  1. EXIT ;
  1. N RMPRSITE,RMPR D KILL^XUSCLEAN
  1. Q
  1. ;
  1. RPTHDR ; Report header
  1. N Y S Y=""
  1. D NOW^%DTC S Y=% X ^DD("DD")
  1. S RPTDT=$P(Y,"@",1)_" "_$P($P(Y,"@",2),":",1,2)
  1. N RA S RA=RMPO("NAME"),PAGE=PAGE+1
  1. W RPTDT,?(40-($L(RA)/2)),RA,?68,"Page: "_PAGE
  1. W !,"Active Home Oxygen Patients by Zip Code",?50,"'*' denotes deceased patient",!
  1. W !,"Zip Code",?12,"Name/Phone Number",?36,"SSN",?43,"Address"
  1. W !,"==========",?12,"=====================",?36,"====",?43,"===================================",!
  1. Q
  1. CNT ;Count the total of patients printed.
  1. I WHO'=D0 S COUNT=COUNT+1,WHO=D0 S:+$G(^DPT(D0,.35)) RMPODCNT=RMPODCNT+1
  1. Q
  1. ;
  1. DIOEND ;TOTAL PRINT RMPR*3.0*179
  1. S COUNT=$E(" ",1,(6-$L(COUNT)))_COUNT
  1. W !!,?47,"Total Patients: ",COUNT
  1. S RMPOCNT=$E(" ",1,(6-$L(RMPODCNT)))_RMPODCNT
  1. W !,?38,"Total Deceased Patients: ",RMPODCNT
  1. Q
  1. SSN ;GET SSN ;RMPR*3.0*179
  1. N RMPOEXP
  1. S X="",RMPOEXP=" " ;RMPR*3.0*179 Flag a deceased patient by attaching an '*' to SSN. ^DPT(D0,.35) direct read supported by ICR #10035
  1. I +$G(^DPT(D0,.35)) S RMPOEXP="*",RMPODCNT=RMPODCNT+1
  1. S RMPOSSN=$E($P($G(^DPT(D0,0)),"^",9),6,9)
  1. S RMPOSSN=RMPOEXP_RMPOSSN
  1. D CNT
  1. Q