| 1 | DGENCD ;ALB/CJM,Zoltan,ISA/KWP,JAN,BRM - Catastrophic Disability Enter/Edit Option;May 24, 1999,Nov 14, 2001 ; 8/4/03 3:01pm
|
|---|
| 2 | ;;5.3;Registration;**121,122,232,237,302,387,451**;Aug 13,1993
|
|---|
| 3 | ;
|
|---|
| 4 | EN ;
|
|---|
| 5 | ;Description: Entry point used for enter/edit catastrophic disability
|
|---|
| 6 | ; information.
|
|---|
| 7 | ;
|
|---|
| 8 | N DFN,QUIT,ERROR
|
|---|
| 9 | S QUIT=0
|
|---|
| 10 | S DFN=$$PATIENT
|
|---|
| 11 | D:DFN EN^DGENLCD(DFN)
|
|---|
| 12 | Q
|
|---|
| 13 | ;
|
|---|
| 14 | EDITCD(DFN) ;
|
|---|
| 15 | ;Description: For a given patient, used for enter/edit catastrophic
|
|---|
| 16 | ; disability information.
|
|---|
| 17 | ;
|
|---|
| 18 | Q:'$G(DFN)
|
|---|
| 19 | N QUIT,ERROR
|
|---|
| 20 | S QUIT=0
|
|---|
| 21 | I $$GET^DGENCDA(DFN,.DGCDIS) D ; If GET CD succeeds ...
|
|---|
| 22 | . ; Set up default values.
|
|---|
| 23 | . S DGCDIS("FACDET")=$$INST^DGENU()
|
|---|
| 24 | . I 'DGCDIS("DATE") S DGCDIS("DATE")=$G(DT)
|
|---|
| 25 | . I 'DGCDIS("REVDTE") S DGCDIS("REVDTE")=DGCDIS("DATE")
|
|---|
| 26 | . I DGCDIS("METDET")="" S DGCDIS("METDET")=""
|
|---|
| 27 | . ; Keep editing until storage succeeds or user gives up ...
|
|---|
| 28 | . F D Q:QUIT
|
|---|
| 29 | . . ; Quit if the editing process isn't completed.
|
|---|
| 30 | . . I '$$EDIT(.DGCDIS) S QUIT=1 Q
|
|---|
| 31 | . . ; Quit if storage is successful.
|
|---|
| 32 | . . I $$STORE^DGENCDA2(DFN,.DGCDIS,.ERROR) S QUIT=1 Q
|
|---|
| 33 | . . ; Quit if the user elects not to try again.
|
|---|
| 34 | . . I '$$AGAIN(.ERROR) S QUIT=1
|
|---|
| 35 | Q
|
|---|
| 36 | ;
|
|---|
| 37 | AGAIN(ERROR) ;
|
|---|
| 38 | ;Description: Asks user whether to try again.
|
|---|
| 39 | ;
|
|---|
| 40 | N DIR,Y
|
|---|
| 41 | W !!,$S(('$L($G(ERROR))):">>> Catastrophic disability information not valid.<<< ",1:">>> "_ERROR_" <<<")
|
|---|
| 42 | S DIR(0)="Y",DIR("A")="Try again",DIR("B")="YES"
|
|---|
| 43 | D ^DIR
|
|---|
| 44 | Q $S(Y=1:1,1:0)
|
|---|
| 45 | ;
|
|---|
| 46 | PATIENT() ;
|
|---|
| 47 | ;Description: Asks user to select a patient.
|
|---|
| 48 | ;
|
|---|
| 49 | N DFN,QUIT
|
|---|
| 50 | S (DFN,QUIT)=""
|
|---|
| 51 | F D Q:(QUIT!DFN)
|
|---|
| 52 | . D GETPAT^DGRPTU(,,.DFN)
|
|---|
| 53 | . I '(DFN>0) S DFN="",QUIT=1 Q
|
|---|
| 54 | . I DFN,'$$VET^DGENPTA(DFN) D
|
|---|
| 55 | . . W !!,"Catastrophic disability can only be entered for eligible veterans!"
|
|---|
| 56 | . . S DFN=""
|
|---|
| 57 | Q DFN
|
|---|
| 58 | ;
|
|---|
| 59 | EDIT(DGCDIS) ;
|
|---|
| 60 | ;Description: Allows user to enter values in DGCDIS array
|
|---|
| 61 | ; which is passed by reference.
|
|---|
| 62 | N SUB,OK,RESPONSE,FLST,EXIT,SUBEXIT,ITEM,FILENUM,FLDNUM,GETOUT,REQ,VAL
|
|---|
| 63 | S OK=1
|
|---|
| 64 | F VAL="BY^1","DATE^1","REVDTE^1","METDET^1" D Q:'OK
|
|---|
| 65 | . S SUB=$P(VAL,"^",1)
|
|---|
| 66 | . S REQ=$P(VAL,"^",2)
|
|---|
| 67 | . S FILENUM=$$FILE^DGENCDU(SUB)
|
|---|
| 68 | . S FLDNUM=$$FLD^DGENCDU(SUB)
|
|---|
| 69 | . I '$$PROMPT^DGENU(FILENUM,FLDNUM,DGCDIS(SUB),.RESPONSE,REQ) S OK=0
|
|---|
| 70 | . E D
|
|---|
| 71 | . . I $P(VAL,"^",1)="BY" S RESPONSE=$$UPPER^DGUTL(RESPONSE)
|
|---|
| 72 | . . S DGCDIS(SUB)=RESPONSE
|
|---|
| 73 | I 'OK Q OK
|
|---|
| 74 | S GETOUT=0
|
|---|
| 75 | F FLST="DIAG","PROC;EXT","COND;SCORE;PERM" D Q:'OK!GETOUT
|
|---|
| 76 | . N LOOKUP
|
|---|
| 77 | . S ITEM="",SUB=$P(FLST,";")
|
|---|
| 78 | . F S ITEM=$O(DGCDIS(SUB,ITEM)) Q:ITEM="" S LOOKUP(DGCDIS(SUB,ITEM))=ITEM
|
|---|
| 79 | . S EXIT=0
|
|---|
| 80 | . S ITEM=1
|
|---|
| 81 | . W !
|
|---|
| 82 | . F D Q:EXIT
|
|---|
| 83 | . . N PC
|
|---|
| 84 | . . S SUB=$P(FLST,";")
|
|---|
| 85 | . . S FILENUM=$$FILE^DGENCDU(SUB)
|
|---|
| 86 | . . S FLDNUM=$$FLD^DGENCDU(SUB)
|
|---|
| 87 | . . W !
|
|---|
| 88 | . . I '$$PROMPT^DGENU(FILENUM,FLDNUM,$G(DGCDIS(SUB,ITEM)),.RESPONSE,0) S (EXIT,GETOUT)=1 Q
|
|---|
| 89 | . . I RESPONSE="" D Q
|
|---|
| 90 | . . . F PC=1:1:$L(FLST,";") K DGCDIS($P(FLST,";",PC),ITEM)
|
|---|
| 91 | . . . S ITEM=$O(DGCDIS(SUB,ITEM))
|
|---|
| 92 | . . . I ITEM="" S EXIT=1
|
|---|
| 93 | . . I $G(LOOKUP(RESPONSE)) S ITEM=LOOKUP(RESPONSE)
|
|---|
| 94 | . . E S ITEM=$O(DGCDIS(SUB,""),-1)+1,LOOKUP(RESPONSE)=ITEM
|
|---|
| 95 | . . S DGCDIS(SUB,ITEM)=RESPONSE
|
|---|
| 96 | . . S SUBEXIT=0
|
|---|
| 97 | . . F PC=2:1:$L(FLST,";") D Q:SUBEXIT
|
|---|
| 98 | . . . S SUB=$P(FLST,";",PC)
|
|---|
| 99 | . . . S FLDNUM=$$FLD^DGENCDU(SUB)
|
|---|
| 100 | . . . I '$$PROMPT^DGENU(FILENUM,FLDNUM,$G(DGCDIS(SUB,ITEM)),.RESPONSE,1) S SUBEXIT=1 Q
|
|---|
| 101 | . . . I RESPONSE="" S (EXIT,SUBEXIT)=1 Q
|
|---|
| 102 | . . . I SUB="EXT" D Q
|
|---|
| 103 | . . . . I '$D(DGCDIS(SUB,ITEM,1)) S DGCDIS(SUB,ITEM,1)=RESPONSE
|
|---|
| 104 | . . . . E S:DGCDIS(SUB,ITEM,1)'=RESPONSE DGCDIS(SUB,ITEM,2)=RESPONSE
|
|---|
| 105 | . . . I SUB="SCORE",'$$VALID^DGENA5(DGCDIS("COND",ITEM),RESPONSE) D Q
|
|---|
| 106 | . . . . W !,"ERROR: This is not a valid test score.",!
|
|---|
| 107 | . . . . Q:$G(DGCDIS("SCORE",ITEM))
|
|---|
| 108 | . . . . K LOOKUP(DGCDIS("COND",ITEM))
|
|---|
| 109 | . . . . F PC=1:1:$L(FLST,";") K DGCDIS($P(FLST,";",PC),ITEM)
|
|---|
| 110 | . . . . S PC=$L(FLST,";")
|
|---|
| 111 | . . . I SUB="SCORE",'$$RANGEMET^DGENA5(DGCDIS("COND",ITEM),RESPONSE,1) D Q
|
|---|
| 112 | . . . . S PC=$L(FLST,";")
|
|---|
| 113 | . . . . S DGCDIS("SCORE",ITEM)=RESPONSE
|
|---|
| 114 | . . . . S DGCDIS("PERM",ITEM)=""
|
|---|
| 115 | . . . S DGCDIS(SUB,ITEM)=RESPONSE
|
|---|
| 116 | . . S ITEM=ITEM+'SUBEXIT
|
|---|
| 117 | S DGCDIS("VCD")="Y"
|
|---|
| 118 | S DGCDIS("VCD")=$S($$ISCD^DGENCDA1(.DGCDIS):"Y",1:"N")
|
|---|
| 119 | S OK=$$PROMPT^DGENU(2,.39,DGCDIS("VCD"),.RESPONSE,0) ; Is Veteran CD?
|
|---|
| 120 | I OK S DGCDIS("VCD")=RESPONSE
|
|---|
| 121 | Q OK
|
|---|
