- DGENCDRP ;ISA/Zoltan - Catastrophic Disability Eligibily Code Report;6/24/99
- ;;5.3;Registration;**232**;Aug 13,1993
- REPORT ; Print a report of all patients having the CATASTROPHICALLY DISABLED
- ; Eligibility code.
- W:$X !!
- W "This routine will print a report of all patients having the",!
- W "inactivated CATASTROPHIC DISABILITY eligibility code.",!
- N PFX,L,DIC,FLDS,BY,DIOBEG,DIOEND
- D DT^DICRW ; Set up FM required variables.
- S PFX="^TMP($J,""DGENCDRP""," ; Partial global reference.
- S DIOBEG="D MAKELIST^DGENCDRP(""^TMP($J,""""DGENCDRP"""")"",$J'="_$J_")"
- S DIOEND="K ^TMP($J,""DGENCDRP"")"
- S L=0 ; No SORT prompt.
- S DIC="^DPT(" ; Global prefix.
- S FLDS="[DGENCD ELIG CODE]" ; Fields to print.
- S BY(0)=PFX ; Sorted list.
- S L(0)=2 ; Number of subscripts in sorted list.
- D EN1^DIP
- Q
- MAKELIST(ARR,SILENT) ;
- ; Returns a list of patients having the CATASTROPHICALLY DISABLED
- ; Eligibility code as either their PRIMARY or SECONDARY Eligibility.
- K @ARR
- S SILENT=''$G(SILENT,0) ; Suppress screen output.
- N ELIG,DFN,X
- I 'SILENT D
- . W "Creating list of patients having the CATASTROPHICALLY DISABLED",!
- . W "Eligibility Code..."
- S ELIG=""
- F S ELIG=$O(^DIC(8,"B","CATASTROPHICALLY DISABLED",ELIG)) Q:ELIG="" D
- . ; "AEL" index ^DPT("AEL",DFN,elig)=""
- . ; Note this inex contains both primary eligibility (#.361) and
- . ; Patient eligibilities (#361).
- . S DFN=""
- . 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)
- Q
- ADD(ARR,DFN) ; Add Patient to array.
- N NAME
- S NAME=$P(^DPT(DFN,0),"^",1)
- S @ARR@(NAME,DFN)=""
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGENCDRP 1635 printed Jan 18, 2025@03:43:12 Page 2
- DGENCDRP ;ISA/Zoltan - Catastrophic Disability Eligibily Code Report;6/24/99
- +1 ;;5.3;Registration;**232**;Aug 13,1993
- REPORT ; Print a report of all patients having the CATASTROPHICALLY DISABLED
- +1 ; Eligibility code.
- +2 if $X
- WRITE !!
- +3 WRITE "This routine will print a report of all patients having the",!
- +4 WRITE "inactivated CATASTROPHIC DISABILITY eligibility code.",!
- +5 NEW PFX,L,DIC,FLDS,BY,DIOBEG,DIOEND
- +6 ; Set up FM required variables.
- DO DT^DICRW
- +7 ; Partial global reference.
- SET PFX="^TMP($J,""DGENCDRP"","
- +8 SET DIOBEG="D MAKELIST^DGENCDRP(""^TMP($J,""""DGENCDRP"""")"",$J'="_$JOB_")"
- +9 SET DIOEND="K ^TMP($J,""DGENCDRP"")"
- +10 ; No SORT prompt.
- SET L=0
- +11 ; Global prefix.
- SET DIC="^DPT("
- +12 ; Fields to print.
- SET FLDS="[DGENCD ELIG CODE]"
- +13 ; Sorted list.
- SET BY(0)=PFX
- +14 ; Number of subscripts in sorted list.
- SET L(0)=2
- +15 DO EN1^DIP
- +16 QUIT
- MAKELIST(ARR,SILENT) ;
- +1 ; Returns a list of patients having the CATASTROPHICALLY DISABLED
- +2 ; Eligibility code as either their PRIMARY or SECONDARY Eligibility.
- +3 KILL @ARR
- +4 ; Suppress screen output.
- SET SILENT=''$GET(SILENT,0)
- +5 NEW ELIG,DFN,X
- +6 IF 'SILENT
- Begin DoDot:1
- +7 WRITE "Creating list of patients having the CATASTROPHICALLY DISABLED",!
- +8 WRITE "Eligibility Code..."
- End DoDot:1
- +9 SET ELIG=""
- +10 FOR
- SET ELIG=$ORDER(^DIC(8,"B","CATASTROPHICALLY DISABLED",ELIG))
- if ELIG=""
- QUIT
- Begin DoDot:1
- +11 ; "AEL" index ^DPT("AEL",DFN,elig)=""
- +12 ; Note this inex contains both primary eligibility (#.361) and
- +13 ; Patient eligibilities (#361).
- +14 SET DFN=""
- +15 FOR X=1:1
- SET DFN=$ORDER(^DPT("AEL",DFN))
- if DFN=""
- QUIT
- if X#10000'!SILENT
- WRITE "."
- IF $DATA(^DPT("AEL",DFN,ELIG))
- DO ADD(ARR,DFN)
- End DoDot:1
- +16 QUIT
- ADD(ARR,DFN) ; Add Patient to array.
- +1 NEW NAME
- +2 SET NAME=$PIECE(^DPT(DFN,0),"^",1)
- +3 SET @ARR@(NAME,DFN)=""
- +4 QUIT