RMPORAP.m

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 ---RMPORAP   2007     printed  Apr 09, 2024@21:38                                                                                                                                                                                                        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