DGENCD ;ALB/CJM,Zoltan,ISA/KWP,JAN,BRM - Catastrophic Disability Enter/Edit Option;May 24, 1999,Nov 14, 2001 ; 8/4/03 3:01pm
;;5.3;Registration;**121,122,232,237,302,387,451,1015**;Aug 13,1993;Build 21
;
EN ;
;Description: Entry point used for enter/edit catastrophic disability
; information.
;
N DFN,QUIT,ERROR
S QUIT=0
S DFN=$$PATIENT
D:DFN EN^DGENLCD(DFN)
Q
;
EDITCD(DFN) ;
;Description: For a given patient, used for enter/edit catastrophic
; disability information.
;
Q:'$G(DFN)
N QUIT,ERROR
S QUIT=0
I $$GET^DGENCDA(DFN,.DGCDIS) D ; If GET CD succeeds ...
. ; Set up default values.
. S DGCDIS("FACDET")=$$INST^DGENU()
. I 'DGCDIS("DATE") S DGCDIS("DATE")=$G(DT)
. I 'DGCDIS("REVDTE") S DGCDIS("REVDTE")=DGCDIS("DATE")
. I DGCDIS("METDET")="" S DGCDIS("METDET")=""
. ; Keep editing until storage succeeds or user gives up ...
. F D Q:QUIT
. . ; Quit if the editing process isn't completed.
. . I '$$EDIT(.DGCDIS) S QUIT=1 Q
. . ; Quit if storage is successful.
. . I $$STORE^DGENCDA2(DFN,.DGCDIS,.ERROR) S QUIT=1 Q
. . ; Quit if the user elects not to try again.
. . I '$$AGAIN(.ERROR) S QUIT=1
Q
;
AGAIN(ERROR) ;
;Description: Asks user whether to try again.
;
N DIR,Y
W !!,$S(('$L($G(ERROR))):">>> Catastrophic disability information not valid.<<< ",1:">>> "_ERROR_" <<<")
S DIR(0)="Y",DIR("A")="Try again",DIR("B")="YES"
D ^DIR
Q $S(Y=1:1,1:0)
;
PATIENT() ;
;Description: Asks user to select a patient.
;
N DFN,QUIT
S (DFN,QUIT)=""
F D Q:(QUIT!DFN)
. D GETPAT^DGRPTU(,,.DFN)
. I '(DFN>0) S DFN="",QUIT=1 Q
. I DFN,'$$VET^DGENPTA(DFN) D
. . W !!,"Catastrophic disability can only be entered for eligible veterans!"
. . S DFN=""
Q DFN
;
EDIT(DGCDIS) ;
;Description: Allows user to enter values in DGCDIS array
; which is passed by reference.
N SUB,OK,RESPONSE,FLST,EXIT,SUBEXIT,ITEM,FILENUM,FLDNUM,GETOUT,REQ,VAL
S OK=1
F VAL="BY^1","DATE^1","REVDTE^1","METDET^1" D Q:'OK
. S SUB=$P(VAL,"^",1)
. S REQ=$P(VAL,"^",2)
. S FILENUM=$$FILE^DGENCDU(SUB)
. S FLDNUM=$$FLD^DGENCDU(SUB)
. I '$$PROMPT^DGENU(FILENUM,FLDNUM,DGCDIS(SUB),.RESPONSE,REQ) S OK=0
. E D
. . I $P(VAL,"^",1)="BY" S RESPONSE=$$UPPER^DGUTL(RESPONSE)
. . S DGCDIS(SUB)=RESPONSE
I 'OK Q OK
S GETOUT=0
F FLST="DIAG","PROC;EXT","COND;SCORE;PERM" D Q:'OK!GETOUT
. N LOOKUP
. S ITEM="",SUB=$P(FLST,";")
. F S ITEM=$O(DGCDIS(SUB,ITEM)) Q:ITEM="" S LOOKUP(DGCDIS(SUB,ITEM))=ITEM
. S EXIT=0
. S ITEM=1
. W !
. F D Q:EXIT
. . N PC
. . S SUB=$P(FLST,";")
. . S FILENUM=$$FILE^DGENCDU(SUB)
. . S FLDNUM=$$FLD^DGENCDU(SUB)
. . W !
. . I '$$PROMPT^DGENU(FILENUM,FLDNUM,$G(DGCDIS(SUB,ITEM)),.RESPONSE,0) S (EXIT,GETOUT)=1 Q
. . I RESPONSE="" D Q
. . . F PC=1:1:$L(FLST,";") K DGCDIS($P(FLST,";",PC),ITEM)
. . . S ITEM=$O(DGCDIS(SUB,ITEM))
. . . I ITEM="" S EXIT=1
. . I $G(LOOKUP(RESPONSE)) S ITEM=LOOKUP(RESPONSE)
. . E S ITEM=$O(DGCDIS(SUB,""),-1)+1,LOOKUP(RESPONSE)=ITEM
. . S DGCDIS(SUB,ITEM)=RESPONSE
. . S SUBEXIT=0
. . F PC=2:1:$L(FLST,";") D Q:SUBEXIT
. . . S SUB=$P(FLST,";",PC)
. . . S FLDNUM=$$FLD^DGENCDU(SUB)
. . . I '$$PROMPT^DGENU(FILENUM,FLDNUM,$G(DGCDIS(SUB,ITEM)),.RESPONSE,1) S SUBEXIT=1 Q
. . . I RESPONSE="" S (EXIT,SUBEXIT)=1 Q
. . . I SUB="EXT" D Q
. . . . I '$D(DGCDIS(SUB,ITEM,1)) S DGCDIS(SUB,ITEM,1)=RESPONSE
. . . . E S:DGCDIS(SUB,ITEM,1)'=RESPONSE DGCDIS(SUB,ITEM,2)=RESPONSE
. . . I SUB="SCORE",'$$VALID^DGENA5(DGCDIS("COND",ITEM),RESPONSE) D Q
. . . . W !,"ERROR: This is not a valid test score.",!
. . . . Q:$G(DGCDIS("SCORE",ITEM))
. . . . K LOOKUP(DGCDIS("COND",ITEM))
. . . . F PC=1:1:$L(FLST,";") K DGCDIS($P(FLST,";",PC),ITEM)
. . . . S PC=$L(FLST,";")
. . . I SUB="SCORE",'$$RANGEMET^DGENA5(DGCDIS("COND",ITEM),RESPONSE,1) D Q
. . . . S PC=$L(FLST,";")
. . . . S DGCDIS("SCORE",ITEM)=RESPONSE
. . . . S DGCDIS("PERM",ITEM)=""
. . . S DGCDIS(SUB,ITEM)=RESPONSE
. . S ITEM=ITEM+'SUBEXIT
S DGCDIS("VCD")="Y"
S DGCDIS("VCD")=$S($$ISCD^DGENCDA1(.DGCDIS):"Y",1:"N")
S OK=$$PROMPT^DGENU(2,.39,DGCDIS("VCD"),.RESPONSE,0) ; Is Veteran CD?
I OK S DGCDIS("VCD")=RESPONSE
Q OK
DGENCD ;ALB/CJM,Zoltan,ISA/KWP,JAN,BRM - Catastrophic Disability Enter/Edit Option;May 24, 1999,Nov 14, 2001 ; 8/4/03 3:01pm
+1 ;;5.3;Registration;**121,122,232,237,302,387,451,1015**;Aug 13,1993;Build 21
+2 ;
EN ;
+1 ;Description: Entry point used for enter/edit catastrophic disability
+2 ; information.
+3 ;
+4 NEW DFN,QUIT,ERROR
+5 SET QUIT=0
+6 SET DFN=$$PATIENT
+7 IF DFN
DO EN^DGENLCD(DFN)
+8 QUIT
+9 ;
EDITCD(DFN) ;
+1 ;Description: For a given patient, used for enter/edit catastrophic
+2 ; disability information.
+3 ;
+4 IF '$GET(DFN)
QUIT
+5 NEW QUIT,ERROR
+6 SET QUIT=0
+7 ; If GET CD succeeds ...
IF $$GET^DGENCDA(DFN,.DGCDIS)
Begin DoDot:1
+8 ; Set up default values.
+9 SET DGCDIS("FACDET")=$$INST^DGENU()
+10 IF 'DGCDIS("DATE")
SET DGCDIS("DATE")=$GET(DT)
+11 IF 'DGCDIS("REVDTE")
SET DGCDIS("REVDTE")=DGCDIS("DATE")
+12 IF DGCDIS("METDET")=""
SET DGCDIS("METDET")=""
+13 ; Keep editing until storage succeeds or user gives up ...
+14 FOR
Begin DoDot:2
+15 ; Quit if the editing process isn't completed.
+16 IF '$$EDIT(.DGCDIS)
SET QUIT=1
QUIT
+17 ; Quit if storage is successful.
+18 IF $$STORE^DGENCDA2(DFN,.DGCDIS,.ERROR)
SET QUIT=1
QUIT
+19 ; Quit if the user elects not to try again.
+20 IF '$$AGAIN(.ERROR)
SET QUIT=1
End DoDot:2
IF QUIT
QUIT
End DoDot:1
+21 QUIT
+22 ;
AGAIN(ERROR) ;
+1 ;Description: Asks user whether to try again.
+2 ;
+3 NEW DIR,Y
+4 WRITE !!,$SELECT(('$LENGTH($GET(ERROR))):">>> Catastrophic disability information not valid.<<< ",1:">>> "_ERROR_" <<<")
+5 SET DIR(0)="Y"
SET DIR("A")="Try again"
SET DIR("B")="YES"
+6 DO ^DIR
+7 QUIT $SELECT(Y=1:1,1:0)
+8 ;
PATIENT() ;
+1 ;Description: Asks user to select a patient.
+2 ;
+3 NEW DFN,QUIT
+4 SET (DFN,QUIT)=""
+5 FOR
Begin DoDot:1
+6 DO GETPAT^DGRPTU(,,.DFN)
+7 IF '(DFN>0)
SET DFN=""
SET QUIT=1
QUIT
+8 IF DFN
IF '$$VET^DGENPTA(DFN)
Begin DoDot:2
+9 WRITE !!,"Catastrophic disability can only be entered for eligible veterans!"
+10 SET DFN=""
End DoDot:2
End DoDot:1
IF (QUIT!DFN)
QUIT
+11 QUIT DFN
+12 ;
EDIT(DGCDIS) ;
+1 ;Description: Allows user to enter values in DGCDIS array
+2 ; which is passed by reference.
+3 NEW SUB,OK,RESPONSE,FLST,EXIT,SUBEXIT,ITEM,FILENUM,FLDNUM,GETOUT,REQ,VAL
+4 SET OK=1
+5 FOR VAL="BY^1","DATE^1","REVDTE^1","METDET^1"
Begin DoDot:1
+6 SET SUB=$PIECE(VAL,"^",1)
+7 SET REQ=$PIECE(VAL,"^",2)
+8 SET FILENUM=$$FILE^DGENCDU(SUB)
+9 SET FLDNUM=$$FLD^DGENCDU(SUB)
+10 IF '$$PROMPT^DGENU(FILENUM,FLDNUM,DGCDIS(SUB),.RESPONSE,REQ)
SET OK=0
+11 IF '$TEST
Begin DoDot:2
+12 IF $PIECE(VAL,"^",1)="BY"
SET RESPONSE=$$UPPER^DGUTL(RESPONSE)
+13 SET DGCDIS(SUB)=RESPONSE
End DoDot:2
End DoDot:1
IF 'OK
QUIT
+14 IF 'OK
QUIT OK
+15 SET GETOUT=0
+16 FOR FLST="DIAG","PROC;EXT","COND;SCORE;PERM"
Begin DoDot:1
+17 NEW LOOKUP
+18 SET ITEM=""
SET SUB=$PIECE(FLST,";")
+19 FOR
SET ITEM=$ORDER(DGCDIS(SUB,ITEM))
IF ITEM=""
QUIT
SET LOOKUP(DGCDIS(SUB,ITEM))=ITEM
+20 SET EXIT=0
+21 SET ITEM=1
+22 WRITE !
+23 FOR
Begin DoDot:2
+24 NEW PC
+25 SET SUB=$PIECE(FLST,";")
+26 SET FILENUM=$$FILE^DGENCDU(SUB)
+27 SET FLDNUM=$$FLD^DGENCDU(SUB)
+28 WRITE !
+29 IF '$$PROMPT^DGENU(FILENUM,FLDNUM,$GET(DGCDIS(SUB,ITEM)),.RESPONSE,0)
SET (EXIT,GETOUT)=1
QUIT
+30 IF RESPONSE=""
Begin DoDot:3
+31 FOR PC=1:1:$LENGTH(FLST,";")
KILL DGCDIS($PIECE(FLST,";",PC),ITEM)
+32 SET ITEM=$ORDER(DGCDIS(SUB,ITEM))
+33 IF ITEM=""
SET EXIT=1
End DoDot:3
QUIT
+34 IF $GET(LOOKUP(RESPONSE))
SET ITEM=LOOKUP(RESPONSE)
+35 IF '$TEST
SET ITEM=$ORDER(DGCDIS(SUB,""),-1)+1
SET LOOKUP(RESPONSE)=ITEM
+36 SET DGCDIS(SUB,ITEM)=RESPONSE
+37 SET SUBEXIT=0
+38 FOR PC=2:1:$LENGTH(FLST,";")
Begin DoDot:3
+39 SET SUB=$PIECE(FLST,";",PC)
+40 SET FLDNUM=$$FLD^DGENCDU(SUB)
+41 IF '$$PROMPT^DGENU(FILENUM,FLDNUM,$GET(DGCDIS(SUB,ITEM)),.RESPONSE,1)
SET SUBEXIT=1
QUIT
+42 IF RESPONSE=""
SET (EXIT,SUBEXIT)=1
QUIT
+43 IF SUB="EXT"
Begin DoDot:4
+44 IF '$DATA(DGCDIS(SUB,ITEM,1))
SET DGCDIS(SUB,ITEM,1)=RESPONSE
+45 IF '$TEST
IF DGCDIS(SUB,ITEM,1)'=RESPONSE
SET DGCDIS(SUB,ITEM,2)=RESPONSE
End DoDot:4
QUIT
+46 IF SUB="SCORE"
IF '$$VALID^DGENA5(DGCDIS("COND",ITEM),RESPONSE)
Begin DoDot:4
+47 WRITE !,"ERROR: This is not a valid test score.",!
+48 IF $GET(DGCDIS("SCORE",ITEM))
QUIT
+49 KILL LOOKUP(DGCDIS("COND",ITEM))
+50 FOR PC=1:1:$LENGTH(FLST,";")
KILL DGCDIS($PIECE(FLST,";",PC),ITEM)
+51 SET PC=$LENGTH(FLST,";")
End DoDot:4
QUIT
+52 IF SUB="SCORE"
IF '$$RANGEMET^DGENA5(DGCDIS("COND",ITEM),RESPONSE,1)
Begin DoDot:4
+53 SET PC=$LENGTH(FLST,";")
+54 SET DGCDIS("SCORE",ITEM)=RESPONSE
+55 SET DGCDIS("PERM",ITEM)=""
End DoDot:4
QUIT
+56 SET DGCDIS(SUB,ITEM)=RESPONSE
End DoDot:3
IF SUBEXIT
QUIT
+57 SET ITEM=ITEM+'SUBEXIT
End DoDot:2
IF EXIT
QUIT
End DoDot:1
IF 'OK!GETOUT
QUIT
+58 SET DGCDIS("VCD")="Y"
+59 SET DGCDIS("VCD")=$SELECT($$ISCD^DGENCDA1(.DGCDIS):"Y",1:"N")
+60 ; Is Veteran CD?
SET OK=$$PROMPT^DGENU(2,.39,DGCDIS("VCD"),.RESPONSE,0)
+61 IF OK
SET DGCDIS("VCD")=RESPONSE
+62 QUIT OK
