Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGMTHL

DGMTHL.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. HARDSHIP ;Entry point for hardships
  1. ; Input -- None
  1. ; Output -- None
  1. N DFN,DGSITE,MTIEN,SGHRD,DGOK,DGDUZ
  1. ;
  1. ;Get Patient file (#2) IEN - DFN
  1. D GETPAT^DGRPTU(,,.DFN,) G ENQ:DFN<0
  1. N DGMDOD S DGMDOD=""
  1. I $P($G(^DPT(DFN,.35)),U)'="" S DGMDOD=$P(^DPT(DFN,.35),U)
  1. I $G(DGMDOD) W !,"Patient died on: ",$$FMTE^XLFDT(DGMDOD,"1D") Q
  1. ;
  1. S (MTIEN,SGHRD,DGSITE)="",DGOK=0
  1. S MTIEN=$$FIND^DGMTH(DFN,DT)
  1. S:MTIEN SGHRD=$P($G(^DGMT(408.31,MTIEN,2)),U,4)
  1. I SGHRD'="" D
  1. . S DGDUZ=$G(DUZ),DGDUZ(2)=$$CONVERT^DGENUPL1(SGHRD,"INSTITUTION")
  1. . S DGOK="",DGSITE=$$INST^DGENU(.DGDUZ,.DGOK)
  1. ;
  1. I SGHRD,$S(DGSITE=+$G(DUZ(2)):0,1:'DGOK) D Q
  1. .W !!?10,"A Hardship has been granted for ",$P(^DPT(DFN,0),U),"."
  1. .W !?10,"Only the site granting the Hardship may edit it."
  1. .W !?10,"Please, contact ",$P($G(^DIC(4,+$$CONVERT^DGENUPL1(SGHRD,"INSTITUTION"),0)),U)," to edit the record.",!
  1. .N DIR S DIR(0)="FAO",DIR("A")="Enter <RETURN> to continue." D ^DIR
  1. ;
  1. ;Load patient enrollment screen
  1. D EN(DFN)
  1. ENQ Q
  1. ;
  1. EN(DFN) ;Entry point for the DGMT HARDSHIP List Template
  1. ; Input -- DFN Patient IEN
  1. ; Output -- None
  1. ;
  1. Q:'$G(DFN)
  1. N HARDSHIP
  1. D WAIT^DICD
  1. D EN^VALM("DGMTH HARDSHIP")
  1. Q
  1. ;
  1. INIT ;Init variables and list array
  1. N MTIEN
  1. S MTIEN=$$FIND^DGMTH(DFN,DT)
  1. I $$GET^DGMTH(MTIEN,.HARDSHIP) ;setup hardship array
  1. D CLEAN^VALM10
  1. S VALMCNT=0
  1. D EN^DGMTHL1("DGMTH HARDSHIP",.HARDSHIP,.VALMCNT)
  1. Q
  1. ;
  1. HELP ;Help code
  1. S X="?" D DISP^XQORM1 W !!
  1. Q
  1. ;
  1. EXIT ;Exit code
  1. D CLEAN^VALM10
  1. D CLEAR^VALM1
  1. Q
  1. ;
  1. EXPND ;Expand code
  1. Q
  1. ;
  1. HDR ;Header code
  1. N X,VA,VAERR
  1. D PID^VADPT
  1. S VALMHDR(1)=$E("Patient: "_$P($G(^DPT(DFN,0)),U),1,30)_" ("_VA("BID")_")"
  1. S X=$S('$D(^DPT(DFN,"TYPE")):"PATIENT TYPE UNKNOWN",$D(^DG(391,+^("TYPE"),0)):$P(^(0),U,1),1:"PATIENT TYPE UNKNOWN")
  1. S VALMHDR(1)=$$SETSTR^VALM1(X,VALMHDR(1),60,80)
  1. Q