- RMPORIP ;(NG)/DG/CAP/HINES CIOFO/HNC -INACTIVE HOME OXYGEN PATIENTS ; 5/18/00 9:35am
- ;;3.0;PROSTHETICS;**29,49,179**;Feb 09, 1996;Build 7
- ;
- ;RMPR*3.0*178 Check for deceased patients. Add to report by
- ; displaying asterisk (*) if patient deceased.
- ;
- SITE ; Initialize site variables
- D HOSITE^RMPOUTL0 Q:'$D(RMPOXITE)
- S RMPODCNT=0
- ;
- FROM ; Ask starting date/oldest inactive date
- K DIR S DIR(0)="D^^^P"
- S DIR("A")="Start at INACTIVATION DATE"
- S DIR("B")="T-180"
- S DIR("?")="Enter the earliest INACTIVATION DATE to report on."
- D ^DIR G:$D(DTOUT)!$D(DUOUT) EXIT
- W " ("_Y(0)_")"
- S FRMDT=Y,FDT=Y(0)
- ;
- TO ; Ask ending/newest inactivation date
- K DIR S DIR(0)="D^^^P"
- S DIR("A")="Ending INACTIVATION DATE"
- S DIR("B")="T"
- S DIR("?")="Enter the latest INACTIVATION DATE to report on."
- D ^DIR G EXIT:$D(DTOUT),FROM:$D(DUOUT)
- W " ("_Y(0)_")",!
- ;
- I Y<FRMDT D G TO
- . W !,"Ending date must NOT be earlier than "_FDT_".",!
- S TODT=Y,TDT=Y(0)
- ;
- LI ; List the sought patients
- K DA,DASH S (COUNT,PAGE,RMEND,RMPORPT,L)=0
- S $P(DASH,"-",79)=""
- D NOW^%DTC S Y=% X ^DD("DD")
- S RPTDT=$P(Y,"@",1)_" "_$P($P(Y,"@",2),":",1,2)
- ;
- S DIC="^RMPR(665,",BY="[RMPO-RPT-HOINACTIVE]"
- S FR=","_$$DATE(FRMDT),TO=","_$$DATE(TODT)
- S DIS(0)="I $P($G(^RMPR(665,D0,""RMPOA"")),U,7)=RMPOXITE"
- S DHD="W ?0 D RPTHDR^RMPORIP"
- S DIOEND="I $G(Y)'[U D DIOEND^RMPORIP S RMEND=1 S:IOST[""P-"" RMPORPT=1"
- S FLDS=".01;C1;L19;""PATIENT"",D SSN^RMPORIP W X;C21;R5;""SSN"",D SDT^RMPORIP W X;C28;L10;""START"""
- S FLDS(2)="D EDT^RMPORIP W X;C40;L10;""INACTIVE"",D IREA^RMPORIP W X;C52;L29;""REASON"""
- D EN1^DIP
- I RMPORPT=0,$G(RMEND) K DIR S DIR(0)="E" D ^DIR
- ;
- EXIT K ^TMP($J) N RMPR,RMPRSITE D KILL^XUSCLEAN
- Q
- ;
- ;*** CONVERT DATE FROM FILEMAN FORMAT TO MM/DD/YYYY
- DATE(FMD) ;
- Q $E(FMD,4,5)_"/"_$E(FMD,6,7)_"/"_($E(FMD,1,3)+1700)
- ;
- EDT ;*** INACTIVATION DATE
- S X=$P($G(^RMPR(665,D0,"RMPOA")),U,3) S:X X=$$DATE(X)
- Q
- ;
- IREA ;*** INACTIVE REASON
- I $D(^RMPR(665,D0,"RMPOA")) D
- . N RMMSG S X=$P(^RMPR(665,D0,"RMPOA"),U,4)
- . S X=$$EXTERNAL^DILFD(665,19.6,"",X,"RMMSG")
- E S X=""
- Q
- ;
- RPTHDR ;*** REPORT HEADER
- N RA S RA=RMPO("NAME"),PAGE=PAGE+1
- W RPTDT,?(40-($L(RA)/2)),RA,?68,"Page: "_PAGE
- W !?5,"Inactive Home Oxygen Patients",?50,"'*' denotes deceased patient",! ;RMPR*3.0*179
- W !?13,"Date Range: ",FDT," to ",TDT,!
- W !,"Patient",?21,"SSN",?28,"Active",?40,"Inactive",?51,"Inactive Reason"
- W !,"===================",?21,"====",?27,"==========",?39,"========== ========================",!
- Q
- ;
- SDT ;*** GET START DATE (USE INITIAL OXYGEN RX DATE)
- S X=$P($G(^RMPR(665,D0,"RMPOA")),U,2) S:X X=$$DATE(X)
- Q
- ;
- SSN ;*** GET SSN
- K VA,VADM S RMPOEXP=" ",RMPODCNT=0 I +$G(^DPT(D0,.35)) S RMPOEXP="*" ;RMPR*3.0*179 Flag a deceased patient by attaching an '*' to SSN. ^DPT(D0,.35) direct read supported by ICR #10035
- S DFN=D0 D ^VADPT
- S X=$P(VA("PID"),"-",3)
- I X'="" S COUNT=COUNT+1,X=RMPOEXP_X S:RMPOEXP'=" " RMPODCNT=RMPODCNT+1 ;RMPR*3.0*179
- Q
- DIOEND ;TOTAL PRINT
- S COUNT=$E(" ",1,(6-$L(COUNT)))_COUNT
- W !!,?47,"Total Patients: ",COUNT
- S RMPODCNT=$E(" ",1,(6-$L(RMPODCNT)))_RMPODCNT ;RMPR*3.0*179
- W !,?38,"Total Deceased Patients: ",RMPODCNT ;RMPR*3.0*179
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPORIP 3329 printed Feb 18, 2025@23:57:56 Page 2
- RMPORIP ;(NG)/DG/CAP/HINES CIOFO/HNC -INACTIVE HOME OXYGEN PATIENTS ; 5/18/00 9:35am
- +1 ;;3.0;PROSTHETICS;**29,49,179**;Feb 09, 1996;Build 7
- +2 ;
- +3 ;RMPR*3.0*178 Check for deceased patients. Add to report by
- +4 ; displaying asterisk (*) if patient deceased.
- +5 ;
- SITE ; Initialize site variables
- +1 DO HOSITE^RMPOUTL0
- if '$DATA(RMPOXITE)
- QUIT
- +2 SET RMPODCNT=0
- +3 ;
- FROM ; Ask starting date/oldest inactive date
- +1 KILL DIR
- SET DIR(0)="D^^^P"
- +2 SET DIR("A")="Start at INACTIVATION DATE"
- +3 SET DIR("B")="T-180"
- +4 SET DIR("?")="Enter the earliest INACTIVATION DATE to report on."
- +5 DO ^DIR
- if $DATA(DTOUT)!$DATA(DUOUT)
- GOTO EXIT
- +6 WRITE " ("_Y(0)_")"
- +7 SET FRMDT=Y
- SET FDT=Y(0)
- +8 ;
- TO ; Ask ending/newest inactivation date
- +1 KILL DIR
- SET DIR(0)="D^^^P"
- +2 SET DIR("A")="Ending INACTIVATION DATE"
- +3 SET DIR("B")="T"
- +4 SET DIR("?")="Enter the latest INACTIVATION DATE to report on."
- +5 DO ^DIR
- if $DATA(DTOUT)
- GOTO EXIT
- if $DATA(DUOUT)
- GOTO FROM
- +6 WRITE " ("_Y(0)_")",!
- +7 ;
- +8 IF Y<FRMDT
- Begin DoDot:1
- +9 WRITE !,"Ending date must NOT be earlier than "_FDT_".",!
- End DoDot:1
- GOTO TO
- +10 SET TODT=Y
- SET TDT=Y(0)
- +11 ;
- LI ; List the sought patients
- +1 KILL DA,DASH
- SET (COUNT,PAGE,RMEND,RMPORPT,L)=0
- +2 SET $PIECE(DASH,"-",79)=""
- +3 DO NOW^%DTC
- SET Y=%
- XECUTE ^DD("DD")
- +4 SET RPTDT=$PIECE(Y,"@",1)_" "_$PIECE($PIECE(Y,"@",2),":",1,2)
- +5 ;
- +6 SET DIC="^RMPR(665,"
- SET BY="[RMPO-RPT-HOINACTIVE]"
- +7 SET FR=","_$$DATE(FRMDT)
- SET TO=","_$$DATE(TODT)
- +8 SET DIS(0)="I $P($G(^RMPR(665,D0,""RMPOA"")),U,7)=RMPOXITE"
- +9 SET DHD="W ?0 D RPTHDR^RMPORIP"
- +10 SET DIOEND="I $G(Y)'[U D DIOEND^RMPORIP S RMEND=1 S:IOST[""P-"" RMPORPT=1"
- +11 SET FLDS=".01;C1;L19;""PATIENT"",D SSN^RMPORIP W X;C21;R5;""SSN"",D SDT^RMPORIP W X;C28;L10;""START"""
- +12 SET FLDS(2)="D EDT^RMPORIP W X;C40;L10;""INACTIVE"",D IREA^RMPORIP W X;C52;L29;""REASON"""
- +13 DO EN1^DIP
- +14 IF RMPORPT=0
- IF $GET(RMEND)
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- +15 ;
- EXIT KILL ^TMP($JOB)
- NEW RMPR,RMPRSITE
- DO KILL^XUSCLEAN
- +1 QUIT
- +2 ;
- +3 ;*** CONVERT DATE FROM FILEMAN FORMAT TO MM/DD/YYYY
- DATE(FMD) ;
- +1 QUIT $EXTRACT(FMD,4,5)_"/"_$EXTRACT(FMD,6,7)_"/"_($EXTRACT(FMD,1,3)+1700)
- +2 ;
- EDT ;*** INACTIVATION DATE
- +1 SET X=$PIECE($GET(^RMPR(665,D0,"RMPOA")),U,3)
- if X
- SET X=$$DATE(X)
- +2 QUIT
- +3 ;
- IREA ;*** INACTIVE REASON
- +1 IF $DATA(^RMPR(665,D0,"RMPOA"))
- Begin DoDot:1
- +2 NEW RMMSG
- SET X=$PIECE(^RMPR(665,D0,"RMPOA"),U,4)
- +3 SET X=$$EXTERNAL^DILFD(665,19.6,"",X,"RMMSG")
- End DoDot:1
- +4 IF '$TEST
- SET X=""
- +5 QUIT
- +6 ;
- RPTHDR ;*** REPORT HEADER
- +1 NEW RA
- SET RA=RMPO("NAME")
- SET PAGE=PAGE+1
- +2 WRITE RPTDT,?(40-($LENGTH(RA)/2)),RA,?68,"Page: "_PAGE
- +3 ;RMPR*3.0*179
- WRITE !?5,"Inactive Home Oxygen Patients",?50,"'*' denotes deceased patient",!
- +4 WRITE !?13,"Date Range: ",FDT," to ",TDT,!
- +5 WRITE !,"Patient",?21,"SSN",?28,"Active",?40,"Inactive",?51,"Inactive Reason"
- +6 WRITE !,"===================",?21,"====",?27,"==========",?39,"========== ========================",!
- +7 QUIT
- +8 ;
- SDT ;*** GET START DATE (USE INITIAL OXYGEN RX DATE)
- +1 SET X=$PIECE($GET(^RMPR(665,D0,"RMPOA")),U,2)
- if X
- SET X=$$DATE(X)
- +2 QUIT
- +3 ;
- SSN ;*** GET SSN
- +1 ;RMPR*3.0*179 Flag a deceased patient by attaching an '*' to SSN. ^DPT(D0,.35) direct read supported by ICR #10035
- KILL VA,VADM
- SET RMPOEXP=" "
- SET RMPODCNT=0
- IF +$GET(^DPT(D0,.35))
- SET RMPOEXP="*"
- +2 SET DFN=D0
- DO ^VADPT
- +3 SET X=$PIECE(VA("PID"),"-",3)
- +4 ;RMPR*3.0*179
- IF X'=""
- SET COUNT=COUNT+1
- SET X=RMPOEXP_X
- if RMPOEXP'=" "
- SET RMPODCNT=RMPODCNT+1
- +5 QUIT
- DIOEND ;TOTAL PRINT
- +1 SET COUNT=$EXTRACT(" ",1,(6-$LENGTH(COUNT)))_COUNT
- +2 WRITE !!,?47,"Total Patients: ",COUNT
- +3 ;RMPR*3.0*179
- SET RMPODCNT=$EXTRACT(" ",1,(6-$LENGTH(RMPODCNT)))_RMPODCNT
- +4 ;RMPR*3.0*179
- WRITE !,?38,"Total Deceased Patients: ",RMPODCNT
- +5 QUIT