DGMTHL.m

DGMTHL ;ALB/CJM,SCG,TMK - Hardship Determinations - List Manager Screen; 1/02/2002

 ;;5.3;PIMS;**182,344,435,467,1015,1016**;JUN 30, 2012;Build 20

 ;

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

DGMTHL    ;ALB/CJM,SCG,TMK - Hardship Determinations - List Manager Screen; 1/02/2002

 +1       ;;5.3;PIMS;**182,344,435,467,1015,1016**;JUN 30, 2012;Build 20

 +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