DGMTHL ;ALB/CJM,SCG,TMK - Hardship Determinations - List Manager Screen; 1/02/2002
;;5.3;Registration;**182,344,435,467,536**;08/13/93;Build 3
;
HARDSHIP ;Entry point for hardships
; Input -- None
; Output -- None
N DFN,DGSITE,MTIEN,SGHRD,DGOK,DGDUZ
;
;Get Patient file (#2) IEN - DFN
D GETPAT^DGRPTU(,,.DFN,) G ENQ:DFN<0
N DGMDOD S DGMDOD=""
I $P($G(^DPT(DFN,.35)),U)'="" S DGMDOD=$P(^DPT(DFN,.35),U)
I $G(DGMDOD) W !,"Patient died on: ",$$FMTE^XLFDT(DGMDOD,"1D") Q
;
S (MTIEN,SGHRD,DGSITE)="",DGOK=0
S MTIEN=$$FIND^DGMTH(DFN,DT)
S:MTIEN SGHRD=$P($G(^DGMT(408.31,MTIEN,2)),U,4)
I SGHRD'="" D
. S DGDUZ=$G(DUZ),DGDUZ(2)=$$CONVERT^DGENUPL1(SGHRD,"INSTITUTION")
. S DGOK="",DGSITE=$$INST^DGENU(.DGDUZ,.DGOK)
;
I SGHRD,$S(DGSITE=+$G(DUZ(2)):0,1:'DGOK) D Q
.W !!?10,"A Hardship has been granted for ",$P(^DPT(DFN,0),U),"."
.W !?10,"Only the site granting the Hardship may edit it."
.W !?10,"Please, contact ",$P($G(^DIC(4,+$$CONVERT^DGENUPL1(SGHRD,"INSTITUTION"),0)),U)," to edit the record.",!
.N DIR S DIR(0)="FAO",DIR("A")="Enter <RETURN> to continue." D ^DIR
;
;Load patient enrollment screen
D EN(DFN)
ENQ Q
;
EN(DFN) ;Entry point for the DGMT HARDSHIP List Template
; Input -- DFN Patient IEN
; Output -- None
;
Q:'$G(DFN)
N HARDSHIP
D WAIT^DICD
D EN^VALM("DGMTH HARDSHIP")
Q
;
INIT ;Init variables and list array
N MTIEN
S MTIEN=$$FIND^DGMTH(DFN,DT)
I $$GET^DGMTH(MTIEN,.HARDSHIP) ;setup hardship array
D CLEAN^VALM10
S VALMCNT=0
D EN^DGMTHL1("DGMTH HARDSHIP",.HARDSHIP,.VALMCNT)
Q
;
HELP ;Help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ;Exit code
D CLEAN^VALM10
D CLEAR^VALM1
Q
;
EXPND ;Expand code
Q
;
HDR ;Header code
N X,VA,VAERR
D PID^VADPT
S VALMHDR(1)=$E("Patient: "_$P($G(^DPT(DFN,0)),U),1,30)_" ("_VA("BID")_")"
S X=$S('$D(^DPT(DFN,"TYPE")):"PATIENT TYPE UNKNOWN",$D(^DG(391,+^("TYPE"),0)):$P(^(0),U,1),1:"PATIENT TYPE UNKNOWN")
S VALMHDR(1)=$$SETSTR^VALM1(X,VALMHDR(1),60,80)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGMTHL 2027 printed Apr 09, 2024@21:55:34 Page 2
DGMTHL ;ALB/CJM,SCG,TMK - Hardship Determinations - List Manager Screen; 1/02/2002
+1 ;;5.3;Registration;**182,344,435,467,536**;08/13/93;Build 3
+2 ;
HARDSHIP ;Entry point for hardships
+1 ; Input -- None
+2 ; Output -- None
+3 NEW DFN,DGSITE,MTIEN,SGHRD,DGOK,DGDUZ
+4 ;
+5 ;Get Patient file (#2) IEN - DFN
+6 DO GETPAT^DGRPTU(,,.DFN,)
if DFN<0
GOTO ENQ
+7 NEW DGMDOD
SET DGMDOD=""
+8 IF $PIECE($GET(^DPT(DFN,.35)),U)'=""
SET DGMDOD=$PIECE(^DPT(DFN,.35),U)
+9 IF $GET(DGMDOD)
WRITE !,"Patient died on: ",$$FMTE^XLFDT(DGMDOD,"1D")
QUIT
+10 ;
+11 SET (MTIEN,SGHRD,DGSITE)=""
SET DGOK=0
+12 SET MTIEN=$$FIND^DGMTH(DFN,DT)
+13 if MTIEN
SET SGHRD=$PIECE($GET(^DGMT(408.31,MTIEN,2)),U,4)
+14 IF SGHRD'=""
Begin DoDot:1
+15 SET DGDUZ=$GET(DUZ)
SET DGDUZ(2)=$$CONVERT^DGENUPL1(SGHRD,"INSTITUTION")
+16 SET DGOK=""
SET DGSITE=$$INST^DGENU(.DGDUZ,.DGOK)
End DoDot:1
+17 ;
+18 IF SGHRD
IF $SELECT(DGSITE=+$GET(DUZ(2)):0,1:'DGOK)
Begin DoDot:1
+19 WRITE !!?10,"A Hardship has been granted for ",$PIECE(^DPT(DFN,0),U),"."
+20 WRITE !?10,"Only the site granting the Hardship may edit it."
+21 WRITE !?10,"Please, contact ",$PIECE($GET(^DIC(4,+$$CONVERT^DGENUPL1(SGHRD,"INSTITUTION"),0)),U)," to edit the record.",!
+22 NEW DIR
SET DIR(0)="FAO"
SET DIR("A")="Enter <RETURN> to continue."
DO ^DIR
End DoDot:1
QUIT
+23 ;
+24 ;Load patient enrollment screen
+25 DO EN(DFN)
ENQ QUIT
+1 ;
EN(DFN) ;Entry point for the DGMT HARDSHIP List Template
+1 ; Input -- DFN Patient IEN
+2 ; Output -- None
+3 ;
+4 if '$GET(DFN)
QUIT
+5 NEW HARDSHIP
+6 DO WAIT^DICD
+7 DO EN^VALM("DGMTH HARDSHIP")
+8 QUIT
+9 ;
INIT ;Init variables and list array
+1 NEW MTIEN
+2 SET MTIEN=$$FIND^DGMTH(DFN,DT)
+3 ;setup hardship array
IF $$GET^DGMTH(MTIEN,.HARDSHIP)
+4 DO CLEAN^VALM10
+5 SET VALMCNT=0
+6 DO EN^DGMTHL1("DGMTH HARDSHIP",.HARDSHIP,.VALMCNT)
+7 QUIT
+8 ;
HELP ;Help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ;Exit code
+1 DO CLEAN^VALM10
+2 DO CLEAR^VALM1
+3 QUIT
+4 ;
EXPND ;Expand code
+1 QUIT
+2 ;
HDR ;Header code
+1 NEW X,VA,VAERR
+2 DO PID^VADPT
+3 SET VALMHDR(1)=$EXTRACT("Patient: "_$PIECE($GET(^DPT(DFN,0)),U),1,30)_" ("_VA("BID")_")"
+4 SET X=$SELECT('$DATA(^DPT(DFN,"TYPE")):"PATIENT TYPE UNKNOWN",$DATA(^DG(391,+^("TYPE"),0)):$PIECE(^(0),U,1),1:"PATIENT TYPE UNKNOWN")
+5 SET VALMHDR(1)=$$SETSTR^VALM1(X,VALMHDR(1),60,80)
+6 QUIT
