| 1 | DGMTHL ;ALB/CJM,SCG - Hardship Determinations - List Manager Screen; 1/02/2002
|
|---|
| 2 | ;;5.3;Registration;**182,344,435,467**;08/13/93
|
|---|
| 3 | ;
|
|---|
| 4 | HARDSHIP ;Entry point for hardships
|
|---|
| 5 | ; Input -- None
|
|---|
| 6 | ; Output -- None
|
|---|
| 7 | N DFN,DGSITE,MTIEN,SGHRD
|
|---|
| 8 | ;
|
|---|
| 9 | ;Get Patient file (#2) IEN - DFN
|
|---|
| 10 | D GETPAT^DGRPTU(,,.DFN,) G ENQ:DFN<0
|
|---|
| 11 | N DGMDOD S DGMDOD=""
|
|---|
| 12 | I $P($G(^DPT(DFN,.35)),U)'="" S DGMDOD=$P(^DPT(DFN,.35),U)
|
|---|
| 13 | I $G(DGMDOD) W !,"Patient died on: ",$$FMTE^XLFDT(DGMDOD,"1D") Q
|
|---|
| 14 | ;
|
|---|
| 15 | S (MTIEN,SGHRD)=""
|
|---|
| 16 | S MTIEN=$$FIND^DGMTH(DFN,DT)
|
|---|
| 17 | S:MTIEN SGHRD=$P($G(^DGMT(408.31,MTIEN,2)),U,4)
|
|---|
| 18 | S DGSITE=$$INST^DGENU()
|
|---|
| 19 | I SGHRD,DGSITE'=SGHRD D Q
|
|---|
| 20 | .W !!?10,"A Hardship has been granted for ",$P(^DPT(DFN,0),U),"."
|
|---|
| 21 | .W !?10,"Only the site granting the Hardship may edit it."
|
|---|
| 22 | .W !?10,"Please, contact ",$P($G(^DIC(4,SGHRD,0)),U)," to edit the record.",!
|
|---|
| 23 | .N DIR S DIR(0)="FAO",DIR("A")="Enter <RETURN> to continue." D ^DIR
|
|---|
| 24 | ;
|
|---|
| 25 | ;Load patient enrollment screen
|
|---|
| 26 | D EN(DFN)
|
|---|
| 27 | ENQ Q
|
|---|
| 28 | ;
|
|---|
| 29 | EN(DFN) ;Entry point for the DGMT HARDSHIP List Template
|
|---|
| 30 | ; Input -- DFN Patient IEN
|
|---|
| 31 | ; Output -- None
|
|---|
| 32 | ;
|
|---|
| 33 | Q:'$G(DFN)
|
|---|
| 34 | N HARDSHIP
|
|---|
| 35 | D WAIT^DICD
|
|---|
| 36 | D EN^VALM("DGMTH HARDSHIP")
|
|---|
| 37 | Q
|
|---|
| 38 | ;
|
|---|
| 39 | INIT ;Init variables and list array
|
|---|
| 40 | N MTIEN
|
|---|
| 41 | S MTIEN=$$FIND^DGMTH(DFN,DT)
|
|---|
| 42 | I $$GET^DGMTH(MTIEN,.HARDSHIP) ;setup hardship array
|
|---|
| 43 | D CLEAN^VALM10
|
|---|
| 44 | S VALMCNT=0
|
|---|
| 45 | D EN^DGMTHL1("DGMTH HARDSHIP",.HARDSHIP,.VALMCNT)
|
|---|
| 46 | Q
|
|---|
| 47 | ;
|
|---|
| 48 | HELP ;Help code
|
|---|
| 49 | S X="?" D DISP^XQORM1 W !!
|
|---|
| 50 | Q
|
|---|
| 51 | ;
|
|---|
| 52 | EXIT ;Exit code
|
|---|
| 53 | D CLEAN^VALM10
|
|---|
| 54 | D CLEAR^VALM1
|
|---|
| 55 | Q
|
|---|
| 56 | ;
|
|---|
| 57 | EXPND ;Expand code
|
|---|
| 58 | Q
|
|---|
| 59 | ;
|
|---|
| 60 | HDR ;Header code
|
|---|
| 61 | N X,VA,VAERR
|
|---|
| 62 | D PID^VADPT
|
|---|
| 63 | S VALMHDR(1)=$E("Patient: "_$P($G(^DPT(DFN,0)),U),1,30)_" ("_VA("BID")_")"
|
|---|
| 64 | S X=$S('$D(^DPT(DFN,"TYPE")):"PATIENT TYPE UNKNOWN",$D(^DG(391,+^("TYPE"),0)):$P(^(0),U,1),1:"PATIENT TYPE UNKNOWN")
|
|---|
| 65 | S VALMHDR(1)=$$SETSTR^VALM1(X,VALMHDR(1),60,80)
|
|---|
| 66 | Q
|
|---|
