RMPORAP ;(NG)/DG/CAP - ACTIVE HOME OXY PTS IN ZIP CODE ORDER ;7/24/98
;;3.0;PROSTHETICS;**29,179**;Feb 09, 1996;Build 7
;
;RMPR*3.0*179 Flag a deceased patient by adding an '*'
; in front of SSN.
;
SITE ;Initialize site variables.
D HOSITE^RMPOUTL0 I '$D(RMPOXITE) Q
;
LI ;List sought patients.
N WHO S (WHO,COUNT,RMEND,RMPOPRT,RMPODCNT)=0 ;RMPR*3.0*179
S DIC="^RMPR(665,"
S DIS(0)="I $P($G(^RMPR(665,D0,""RMPOA"")),U,7)=RMPOXITE,$P($G(^RMPR(665,D0,""RMPOA"")),U,3)="""""
S BY="[RMPO-RPT-HOACTZIPLIST]"
S FR="",PAGE=0
S FLDS="[RMPO-RPT-HOACTZIPLIST]"
S DHD="W ?0 D RPTHDR^RMPORAP"
S DHIT="D CNT^RMPORAP"
S DIOEND="I $G(Y)'[U D DIOEND^RMPORAP S RMEND=1 S:IOST[""P-"" RMPOPRT=1" ;RMPR*3.0*179
D EN1^DIP
I RMPOPRT=0,$G(RMEND) K DIR S DIR(0)="E" D ^DIR
D EXIT
Q
;
EXIT ;
N RMPRSITE,RMPR D KILL^XUSCLEAN
Q
;
RPTHDR ; Report header
N Y S Y=""
D NOW^%DTC S Y=% X ^DD("DD")
S RPTDT=$P(Y,"@",1)_" "_$P($P(Y,"@",2),":",1,2)
N RA S RA=RMPO("NAME"),PAGE=PAGE+1
W RPTDT,?(40-($L(RA)/2)),RA,?68,"Page: "_PAGE
W !,"Active Home Oxygen Patients by Zip Code",?50,"'*' denotes deceased patient",!
W !,"Zip Code",?12,"Name/Phone Number",?36,"SSN",?43,"Address"
W !,"==========",?12,"=====================",?36,"====",?43,"===================================",!
Q
CNT ;Count the total of patients printed.
I WHO'=D0 S COUNT=COUNT+1,WHO=D0 S:+$G(^DPT(D0,.35)) RMPODCNT=RMPODCNT+1
Q
;
DIOEND ;TOTAL PRINT RMPR*3.0*179
S COUNT=$E(" ",1,(6-$L(COUNT)))_COUNT
W !!,?47,"Total Patients: ",COUNT
S RMPOCNT=$E(" ",1,(6-$L(RMPODCNT)))_RMPODCNT
W !,?38,"Total Deceased Patients: ",RMPODCNT
Q
SSN ;GET SSN ;RMPR*3.0*179
N RMPOEXP
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
I +$G(^DPT(D0,.35)) S RMPOEXP="*",RMPODCNT=RMPODCNT+1
S RMPOSSN=$E($P($G(^DPT(D0,0)),"^",9),6,9)
S RMPOSSN=RMPOEXP_RMPOSSN
D CNT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPORAP 2007 printed Nov 22, 2024@17:41:27 Page 2
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
+2 ;
+3 ;RMPR*3.0*179 Flag a deceased patient by adding an '*'
+4 ; in front of SSN.
+5 ;
SITE ;Initialize site variables.
+1 DO HOSITE^RMPOUTL0
IF '$DATA(RMPOXITE)
QUIT
+2 ;
LI ;List sought patients.
+1 ;RMPR*3.0*179
NEW WHO
SET (WHO,COUNT,RMEND,RMPOPRT,RMPODCNT)=0
+2 SET DIC="^RMPR(665,"
+3 SET DIS(0)="I $P($G(^RMPR(665,D0,""RMPOA"")),U,7)=RMPOXITE,$P($G(^RMPR(665,D0,""RMPOA"")),U,3)="""""
+4 SET BY="[RMPO-RPT-HOACTZIPLIST]"
+5 SET FR=""
SET PAGE=0
+6 SET FLDS="[RMPO-RPT-HOACTZIPLIST]"
+7 SET DHD="W ?0 D RPTHDR^RMPORAP"
+8 SET DHIT="D CNT^RMPORAP"
+9 ;RMPR*3.0*179
SET DIOEND="I $G(Y)'[U D DIOEND^RMPORAP S RMEND=1 S:IOST[""P-"" RMPOPRT=1"
+10 DO EN1^DIP
+11 IF RMPOPRT=0
IF $GET(RMEND)
KILL DIR
SET DIR(0)="E"
DO ^DIR
+12 DO EXIT
+13 QUIT
+14 ;
EXIT ;
+1 NEW RMPRSITE,RMPR
DO KILL^XUSCLEAN
+2 QUIT
+3 ;
RPTHDR ; Report header
+1 NEW Y
SET Y=""
+2 DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
+3 SET RPTDT=$PIECE(Y,"@",1)_" "_$PIECE($PIECE(Y,"@",2),":",1,2)
+4 NEW RA
SET RA=RMPO("NAME")
SET PAGE=PAGE+1
+5 WRITE RPTDT,?(40-($LENGTH(RA)/2)),RA,?68,"Page: "_PAGE
+6 WRITE !,"Active Home Oxygen Patients by Zip Code",?50,"'*' denotes deceased patient",!
+7 WRITE !,"Zip Code",?12,"Name/Phone Number",?36,"SSN",?43,"Address"
+8 WRITE !,"==========",?12,"=====================",?36,"====",?43,"===================================",!
+9 QUIT
CNT ;Count the total of patients printed.
+1 IF WHO'=D0
SET COUNT=COUNT+1
SET WHO=D0
if +$GET(^DPT(D0,.35))
SET RMPODCNT=RMPODCNT+1
+2 QUIT
+3 ;
DIOEND ;TOTAL PRINT RMPR*3.0*179
+1 SET COUNT=$EXTRACT(" ",1,(6-$LENGTH(COUNT)))_COUNT
+2 WRITE !!,?47,"Total Patients: ",COUNT
+3 SET RMPOCNT=$EXTRACT(" ",1,(6-$LENGTH(RMPODCNT)))_RMPODCNT
+4 WRITE !,?38,"Total Deceased Patients: ",RMPODCNT
+5 QUIT
SSN ;GET SSN ;RMPR*3.0*179
+1 NEW RMPOEXP
+2 ;RMPR*3.0*179 Flag a deceased patient by attaching an '*' to SSN. ^DPT(D0,.35) direct read supported by ICR #10035
SET X=""
SET RMPOEXP=" "
+3 IF +$GET(^DPT(D0,.35))
SET RMPOEXP="*"
SET RMPODCNT=RMPODCNT+1
+4 SET RMPOSSN=$EXTRACT($PIECE($GET(^DPT(D0,0)),"^",9),6,9)
+5 SET RMPOSSN=RMPOEXP_RMPOSSN
+6 DO CNT
+7 QUIT
