- 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 Feb 18, 2025@23:57:55 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