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

DGENCDRP.m

Go to the documentation of this file.
  1. DGENCDRP ;ISA/Zoltan - Catastrophic Disability Eligibily Code Report;6/24/99
  1. ;;5.3;Registration;**232**;Aug 13,1993
  1. REPORT ; Print a report of all patients having the CATASTROPHICALLY DISABLED
  1. ; Eligibility code.
  1. W:$X !!
  1. W "This routine will print a report of all patients having the",!
  1. W "inactivated CATASTROPHIC DISABILITY eligibility code.",!
  1. N PFX,L,DIC,FLDS,BY,DIOBEG,DIOEND
  1. D DT^DICRW ; Set up FM required variables.
  1. S PFX="^TMP($J,""DGENCDRP""," ; Partial global reference.
  1. S DIOBEG="D MAKELIST^DGENCDRP(""^TMP($J,""""DGENCDRP"""")"",$J'="_$J_")"
  1. S DIOEND="K ^TMP($J,""DGENCDRP"")"
  1. S L=0 ; No SORT prompt.
  1. S DIC="^DPT(" ; Global prefix.
  1. S FLDS="[DGENCD ELIG CODE]" ; Fields to print.
  1. S BY(0)=PFX ; Sorted list.
  1. S L(0)=2 ; Number of subscripts in sorted list.
  1. D EN1^DIP
  1. Q
  1. MAKELIST(ARR,SILENT) ;
  1. ; Returns a list of patients having the CATASTROPHICALLY DISABLED
  1. ; Eligibility code as either their PRIMARY or SECONDARY Eligibility.
  1. K @ARR
  1. S SILENT=''$G(SILENT,0) ; Suppress screen output.
  1. N ELIG,DFN,X
  1. I 'SILENT D
  1. . W "Creating list of patients having the CATASTROPHICALLY DISABLED",!
  1. . W "Eligibility Code..."
  1. S ELIG=""
  1. F S ELIG=$O(^DIC(8,"B","CATASTROPHICALLY DISABLED",ELIG)) Q:ELIG="" D
  1. . ; "AEL" index ^DPT("AEL",DFN,elig)=""
  1. . ; Note this inex contains both primary eligibility (#.361) and
  1. . ; Patient eligibilities (#361).
  1. . S DFN=""
  1. . F X=1:1 S DFN=$O(^DPT("AEL",DFN)) Q:DFN="" W:X#10000'!SILENT "." I $D(^DPT("AEL",DFN,ELIG)) D ADD(ARR,DFN)
  1. Q
  1. ADD(ARR,DFN) ; Add Patient to array.
  1. N NAME
  1. S NAME=$P(^DPT(DFN,0),"^",1)
  1. S @ARR@(NAME,DFN)=""
  1. Q