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 Dec 13, 2024@02:31:28 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
