AMHLETPU.m

AMHLETPU  ;IHS/TUCSON/LAB - TP PLAN UTILITIES 

 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010

 ;

 ;

EN ;EP - called from option

 D GETPAT

 I 'DFN K DFN W !,"Bye..." Q

 D EN1

 Q

EN1 ;EP - called from protocol

 ;DFN must be equal to patient

 Q:'$G(DFN)

 Q:'$D(^DPT(DFN))

 ;get device

 S XBRP="PRINT^AMHLETPP",XBRC="COMP^AMHLETPU",XBRX="XIT^AMHLETPU",XBNS="AMH;DFN"

 D ^XBDBQUE

 D EXIT

 Q

GETPAT ;get patient

 S DFN=""

 W !

 S DIC="^AUPNPAT(",DIC(0)="AEMQ" D ^DIC K DIC

 Q:Y<0

 S (DFN,AMHPAT)=+Y

 I $G(AUPNDOD)]"" W !!?10,"***** PATIENT'S DATE OF DEATH IS ",$$FMTE^XLFDT(AUPNDOD),!! H 2

 Q

EXIT ;EP

 D TERM^VALM0

 S VALMBCK="R"

 D GATHER^AMHLETP

 S VALMCNT=AMHLINE

 D HDR^AMHLETP

 K AMHX,AMHQUIT,AMHTP,AMHNODE,AMHG,AMHDA,AMHFILE,AMHC,AMHGIEN,AMHLEC,AMHLETP,AMHLETXT,AMHPCNT,AMHPRNM,AMHTP,AMHRMETH

 K D,D0,DA,DD,DIADD,DIC,DICR,DIE,DIG,DIH,DIK,DINUM,DIR,DIRUT,DIU,DIV,DIW,DIWF,DIWL,DIWR,DIY,DLAYGO,DO,DQ,DR,DTOUT,DUOUT

 K X,Y,Z,I

 Q

COMP ;EP - called from xbdbque

 Q

XIT ;EP - clean up all variables used by display/print

 K AMHC,AMHD,AMHDA,AMHFILE,AMHGIEN,AMHLEC,AMHLETP,AMHLETXT,AMHNODE,AMHPCNT,AMHPG,AMHPRNM,AMHQUIT,AMHRMETH,AMHTP,AMHG,AMHGIEN,AMHLINE,AMHPCNT,AMHX

 K D,D0,DA,DD,DIADD,DIC,DIE,DIG,DIH,DIK,DINUM,DIR,DIRUT,DIU,DIV,DIW,DIWF,DIWL,DIWR,DIY,DLAYGO,DO,DQ,DR,DTOUT,DUOUT,I,X,Y,Z

 Q

AMHLETPU  ;IHS/TUCSON/LAB - TP PLAN UTILITIES 

 +1       ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010

 +2       ;

 +3       ;

EN        ;EP - called from option

 +1        DO GETPAT

 +2        IF 'DFN

               KILL DFN

               WRITE !,"Bye..."

               QUIT 

 +3        DO EN1

 +4        QUIT 

EN1       ;EP - called from protocol

 +1       ;DFN must be equal to patient

 +2        IF '$GET(DFN)

               QUIT 

 +3        IF '$DATA(^DPT(DFN))

               QUIT 

 +4       ;get device

 +5        SET XBRP="PRINT^AMHLETPP"

           SET XBRC="COMP^AMHLETPU"

           SET XBRX="XIT^AMHLETPU"

           SET XBNS="AMH;DFN"

 +6        DO ^XBDBQUE

 +7        DO EXIT

 +8        QUIT 

GETPAT    ;get patient

 +1        SET DFN=""

 +2        WRITE !

 +3        SET DIC="^AUPNPAT("

           SET DIC(0)="AEMQ"

           DO ^DIC

           KILL DIC

 +4        IF Y<0

               QUIT 

 +5        SET (DFN,AMHPAT)=+Y

 +6        IF $GET(AUPNDOD)]""

               WRITE !!?10,"***** PATIENT'S DATE OF DEATH IS ",$$FMTE^XLFDT(AUPNDOD),!!

               HANG 2

 +7        QUIT 

EXIT      ;EP

 +1        DO TERM^VALM0

 +2        SET VALMBCK="R"

 +3        DO GATHER^AMHLETP

 +4        SET VALMCNT=AMHLINE

 +5        DO HDR^AMHLETP

 +6        KILL AMHX,AMHQUIT,AMHTP,AMHNODE,AMHG,AMHDA,AMHFILE,AMHC,AMHGIEN,AMHLEC,AMHLETP,AMHLETXT,AMHPCNT,AMHPRNM,AMHTP,AMHRMETH

 +7        KILL D,D0,DA,DD,DIADD,DIC,DICR,DIE,DIG,DIH,DIK,DINUM,DIR,DIRUT,DIU,DIV,DIW,DIWF,DIWL,DIWR,DIY,DLAYGO,DO,DQ,DR,DTOUT,DUOUT

 +8        KILL X,Y,Z,I

 +9        QUIT 

COMP      ;EP - called from xbdbque

 +1        QUIT 

XIT       ;EP - clean up all variables used by display/print

 +1        KILL AMHC,AMHD,AMHDA,AMHFILE,AMHGIEN,AMHLEC,AMHLETP,AMHLETXT,AMHNODE,AMHPCNT,AMHPG,AMHPRNM,AMHQUIT,AMHRMETH,AMHTP,AMHG,AMHGIEN,AMHLINE,AMHPCNT,AMHX

 +2        KILL D,D0,DA,DD,DIADD,DIC,DIE,DIG,DIH,DIK,DINUM,DIR,DIRUT,DIU,DIV,DIW,DIWF,DIWL,DIWR,DIY,DLAYGO,DO,DQ,DR,DTOUT,DUOUT,I,X,Y,Z

 +3        QUIT