Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RMPORIP

RMPORIP.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ;RMPR*3.0*178 Check for deceased patients. Add to report by
  1. ; displaying asterisk (*) if patient deceased.
  1. ;
  1. SITE ; Initialize site variables
  1. D HOSITE^RMPOUTL0 Q:'$D(RMPOXITE)
  1. S RMPODCNT=0
  1. ;
  1. FROM ; Ask starting date/oldest inactive date
  1. K DIR S DIR(0)="D^^^P"
  1. S DIR("A")="Start at INACTIVATION DATE"
  1. S DIR("B")="T-180"
  1. S DIR("?")="Enter the earliest INACTIVATION DATE to report on."
  1. D ^DIR G:$D(DTOUT)!$D(DUOUT) EXIT
  1. W " ("_Y(0)_")"
  1. S FRMDT=Y,FDT=Y(0)
  1. ;
  1. TO ; Ask ending/newest inactivation date
  1. K DIR S DIR(0)="D^^^P"
  1. S DIR("A")="Ending INACTIVATION DATE"
  1. S DIR("B")="T"
  1. S DIR("?")="Enter the latest INACTIVATION DATE to report on."
  1. D ^DIR G EXIT:$D(DTOUT),FROM:$D(DUOUT)
  1. W " ("_Y(0)_")",!
  1. ;
  1. I Y<FRMDT D G TO
  1. . W !,"Ending date must NOT be earlier than "_FDT_".",!
  1. S TODT=Y,TDT=Y(0)
  1. ;
  1. LI ; List the sought patients
  1. K DA,DASH S (COUNT,PAGE,RMEND,RMPORPT,L)=0
  1. S $P(DASH,"-",79)=""
  1. D NOW^%DTC S Y=% X ^DD("DD")
  1. S RPTDT=$P(Y,"@",1)_" "_$P($P(Y,"@",2),":",1,2)
  1. ;
  1. S DIC="^RMPR(665,",BY="[RMPO-RPT-HOINACTIVE]"
  1. S FR=","_$$DATE(FRMDT),TO=","_$$DATE(TODT)
  1. S DIS(0)="I $P($G(^RMPR(665,D0,""RMPOA"")),U,7)=RMPOXITE"
  1. S DHD="W ?0 D RPTHDR^RMPORIP"
  1. S DIOEND="I $G(Y)'[U D DIOEND^RMPORIP S RMEND=1 S:IOST[""P-"" RMPORPT=1"
  1. S FLDS=".01;C1;L19;""PATIENT"",D SSN^RMPORIP W X;C21;R5;""SSN"",D SDT^RMPORIP W X;C28;L10;""START"""
  1. S FLDS(2)="D EDT^RMPORIP W X;C40;L10;""INACTIVE"",D IREA^RMPORIP W X;C52;L29;""REASON"""
  1. D EN1^DIP
  1. I RMPORPT=0,$G(RMEND) K DIR S DIR(0)="E" D ^DIR
  1. ;
  1. EXIT K ^TMP($J) N RMPR,RMPRSITE D KILL^XUSCLEAN
  1. Q
  1. ;
  1. ;*** CONVERT DATE FROM FILEMAN FORMAT TO MM/DD/YYYY
  1. DATE(FMD) ;
  1. Q $E(FMD,4,5)_"/"_$E(FMD,6,7)_"/"_($E(FMD,1,3)+1700)
  1. ;
  1. EDT ;*** INACTIVATION DATE
  1. S X=$P($G(^RMPR(665,D0,"RMPOA")),U,3) S:X X=$$DATE(X)
  1. Q
  1. ;
  1. IREA ;*** INACTIVE REASON
  1. I $D(^RMPR(665,D0,"RMPOA")) D
  1. . N RMMSG S X=$P(^RMPR(665,D0,"RMPOA"),U,4)
  1. . S X=$$EXTERNAL^DILFD(665,19.6,"",X,"RMMSG")
  1. E S X=""
  1. Q
  1. ;
  1. RPTHDR ;*** REPORT HEADER
  1. N RA S RA=RMPO("NAME"),PAGE=PAGE+1
  1. W RPTDT,?(40-($L(RA)/2)),RA,?68,"Page: "_PAGE
  1. W !?5,"Inactive Home Oxygen Patients",?50,"'*' denotes deceased patient",! ;RMPR*3.0*179
  1. W !?13,"Date Range: ",FDT," to ",TDT,!
  1. W !,"Patient",?21,"SSN",?28,"Active",?40,"Inactive",?51,"Inactive Reason"
  1. W !,"===================",?21,"====",?27,"==========",?39,"========== ========================",!
  1. Q
  1. ;
  1. SDT ;*** GET START DATE (USE INITIAL OXYGEN RX DATE)
  1. S X=$P($G(^RMPR(665,D0,"RMPOA")),U,2) S:X X=$$DATE(X)
  1. Q
  1. ;
  1. SSN ;*** GET SSN
  1. 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
  1. S DFN=D0 D ^VADPT
  1. S X=$P(VA("PID"),"-",3)
  1. I X'="" S COUNT=COUNT+1,X=RMPOEXP_X S:RMPOEXP'=" " RMPODCNT=RMPODCNT+1 ;RMPR*3.0*179
  1. Q
  1. DIOEND ;TOTAL PRINT
  1. S COUNT=$E(" ",1,(6-$L(COUNT)))_COUNT
  1. W !!,?47,"Total Patients: ",COUNT
  1. S RMPODCNT=$E(" ",1,(6-$L(RMPODCNT)))_RMPODCNT ;RMPR*3.0*179
  1. W !,?38,"Total Deceased Patients: ",RMPODCNT ;RMPR*3.0*179
  1. Q