AMHLEI3.m

AMHLEI3 ; IHS/CMI/LAB - treatment plan update ;

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

 ;

PRINT ;EP

 I '$G(AMHPAT) W !!,"ERROR - Patient not defined!" Q

 D FULL^VALM1

 ;print or browse

 W ! S DIR(0)="S^P:PRINT Output on Paper;B:BROWSE Output on Screen",DIR("A")="Do you wish to",DIR("B")="P" K DA D ^DIR K DIR

 I $D(DIRUT) D PAUSE,BACK^AMHLEI Q

 I $G(Y)="B" D BROWSE D BACK^AMHLEI Q

 D EN1

 D BACK^AMHLEI

 Q

BROWSE ;

 S AMHBROW=1 D VIEWR^XBLM("PRINT1^AMHLEI3","Display of Intake Document") K AMHBROW

 Q

EN1 ;EP - called from protocol

 ;DFN must be equal to patient

 Q:'$G(DFN)

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

 ;get device

 S XBRP="PRINT1^AMHLEI3",XBRC="",XBRX="XIT^AMHLEI3",XBNS="AMH;DFN"

 D ^XBDBQUE

 D BACK^AMHLEI

 Q

XIT ;

 Q

PAUSE ;EP

 S DIR(0)="EO",DIR("A")="Press enter to continue...." D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 Q

PRINT1 ;EP - called from xbdbque

 Q:'$G(DFN)

 I '$D(^AMHPINTK(DFN)) D HEAD W !!,"No INTAKE Document on file for ",$P(^DPT(DFN,0),U) Q

 S (AMHQUIT,AMHPG)=0

 D HEAD

 W !!?2,"Initial Intake:  ",?27,$$VAL^XBDIQ1(9002011.07,DFN,.07)

 W !?2,"      Provider:  ",?27,$$VAL^XBDIQ1(9002011.07,DFN,.08)

 W !!?2,"    Last Update:  ",?27,$$VAL^XBDIQ1(9002011.07,DFN,.02)

 W !?2,"      Provider:  ",?27,$$VAL^XBDIQ1(9002011.07,DFN,.02)

 I $O(^AMHPINTK(DFN,10,0)) D  Q:AMHQUIT

 .W !!?2,"Referred By:",!

 .K AMHPCNT,AMHPRNM S AMHPCNT=0,AMHNODE=10,AMHDA=DFN,AMHFILE=9002011.07 D WP^AMHLETP4

 .I $D(AMHPRNM) S X=0 F  S X=$O(AMHPRNM(X)) Q:X'=+X!(AMHQUIT)  D:$Y>(IOSL-3) HEAD Q:AMHQUIT  W ?5,AMHPRNM(X),!

 .Q:AMHQUIT

 W !!?2,"Intake Documentation/Narrative:",!

 K AMHPCNT,AMHPRNM S AMHPCNT=0,AMHNODE=41,AMHDA=DFN,AMHFILE=9002011.07 D WP^AMHLETP4

 I $D(AMHPRNM) S X=0 F  S X=$O(AMHPRNM(X)) Q:X'=+X!(AMHQUIT)  D:$Y>(IOSL-3) HEAD Q:AMHQUIT  W ?5,AMHPRNM(X),!

 Q:$G(AMHBROW)

 I $Y>(IOSL-8) D HEAD Q:AMHQUIT

 S X=IOSL-$Y S X=X-8 F I=1:1:X W !

 W !,"________________________________________",?52,"__________________"

 W !?60,"DATE"

 W !!!,"________________________________________",?52,"__________________"

 W !?60,"DATE"

 K AMHPG,AMHQUIT,AMHPRNM,AMHNODE,AMHPCNT,AMHFILE

 Q

HEAD ;ENTRY POINT

 I 'AMHPG G HEAD1

 NEW X

 I '$G(AMHBROW),$E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S AMHQUIT=1 Q

HEAD1 ;EP

 W:$D(IOF) @IOF S AMHPG=AMHPG+1

 W !?13,"********** CONFIDENTIAL PATIENT INFORMATION **********"

 W !,$TR($J("",80)," ","*")

 W !,"*",?79,"*"

 W !,"*  INTAKE DOCUMENT",?45,"Printed: ",$$FMTE^XLFDT($$NOW^XLFDT),?79,"*"

 W !,"*  Name:  ",$P(^DPT(DFN,0),U),?68,"Page ",AMHPG,?79,"*"

 W !,"*  ",$E($P(^DIC(4,DUZ(2),0),U),1,25),?30,"DOB:  ",$$FMTE^XLFDT($P(^DPT(DFN,0),U,3),"2D"),?46,"Sex:  ",$P(^DPT(DFN,0),U,2),?54,"  Chart #:  ",$P(^AUTTLOC(DUZ(2),0),U,7),$P($G(^AUPNPAT(DFN,41,DUZ(2),0)),U,2),?79,"*"

 W !,"*",?79,"*"

 W !,$TR($J("",80)," ","*"),!

 Q

AMHLEI3   ; IHS/CMI/LAB - treatment plan update ;

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

 +2       ;

PRINT     ;EP

 +1        IF '$GET(AMHPAT)

               WRITE !!,"ERROR - Patient not defined!"

               QUIT 

 +2        DO FULL^VALM1

 +3       ;print or browse

 +4        WRITE !

           SET DIR(0)="S^P:PRINT Output on Paper;B:BROWSE Output on Screen"

           SET DIR("A")="Do you wish to"

           SET DIR("B")="P"

           KILL DA

           DO ^DIR

           KILL DIR

 +5        IF $DATA(DIRUT)

               DO PAUSE

               DO BACK^AMHLEI

               QUIT 

 +6        IF $GET(Y)="B"

               DO BROWSE

               DO BACK^AMHLEI

               QUIT 

 +7        DO EN1

 +8        DO BACK^AMHLEI

 +9        QUIT 

BROWSE    ;

 +1        SET AMHBROW=1

           DO VIEWR^XBLM("PRINT1^AMHLEI3","Display of Intake Document")

           KILL AMHBROW

 +2        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="PRINT1^AMHLEI3"

           SET XBRC=""

           SET XBRX="XIT^AMHLEI3"

           SET XBNS="AMH;DFN"

 +6        DO ^XBDBQUE

 +7        DO BACK^AMHLEI

 +8        QUIT 

XIT       ;

 +1        QUIT 

PAUSE     ;EP

 +1        SET DIR(0)="EO"

           SET DIR("A")="Press enter to continue...."

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        QUIT 

PRINT1    ;EP - called from xbdbque

 +1        IF '$GET(DFN)

               QUIT 

 +2        IF '$DATA(^AMHPINTK(DFN))

               DO HEAD

               WRITE !!,"No INTAKE Document on file for ",$PIECE(^DPT(DFN,0),U)

               QUIT 

 +3        SET (AMHQUIT,AMHPG)=0

 +4        DO HEAD

 +5        WRITE !!?2,"Initial Intake:  ",?27,$$VAL^XBDIQ1(9002011.07,DFN,.07)

 +6        WRITE !?2,"      Provider:  ",?27,$$VAL^XBDIQ1(9002011.07,DFN,.08)

 +7        WRITE !!?2,"    Last Update:  ",?27,$$VAL^XBDIQ1(9002011.07,DFN,.02)

 +8        WRITE !?2,"      Provider:  ",?27,$$VAL^XBDIQ1(9002011.07,DFN,.02)

 +9        IF $ORDER(^AMHPINTK(DFN,10,0))

               Begin DoDot:1

 +10               WRITE !!?2,"Referred By:",!

 +11               KILL AMHPCNT,AMHPRNM

                   SET AMHPCNT=0

                   SET AMHNODE=10

                   SET AMHDA=DFN

                   SET AMHFILE=9002011.07

                   DO WP^AMHLETP4

 +12               IF $DATA(AMHPRNM)

                       SET X=0

                       FOR 

                           SET X=$ORDER(AMHPRNM(X))

                           IF X'=+X!(AMHQUIT)

                               QUIT 

                           IF $Y>(IOSL-3)

                               DO HEAD

                           IF AMHQUIT

                               QUIT 

                           WRITE ?5,AMHPRNM(X),!

 +13               IF AMHQUIT

                       QUIT 

               End DoDot:1

               IF AMHQUIT

                   QUIT 

 +14       WRITE !!?2,"Intake Documentation/Narrative:",!

 +15       KILL AMHPCNT,AMHPRNM

           SET AMHPCNT=0

           SET AMHNODE=41

           SET AMHDA=DFN

           SET AMHFILE=9002011.07

           DO WP^AMHLETP4

 +16       IF $DATA(AMHPRNM)

               SET X=0

               FOR 

                   SET X=$ORDER(AMHPRNM(X))

                   IF X'=+X!(AMHQUIT)

                       QUIT 

                   IF $Y>(IOSL-3)

                       DO HEAD

                   IF AMHQUIT

                       QUIT 

                   WRITE ?5,AMHPRNM(X),!

 +17       IF $GET(AMHBROW)

               QUIT 

 +18       IF $Y>(IOSL-8)

               DO HEAD

               IF AMHQUIT

                   QUIT 

 +19       SET X=IOSL-$Y

           SET X=X-8

           FOR I=1:1:X

               WRITE !

 +20       WRITE !,"________________________________________",?52,"__________________"

 +21       WRITE !?60,"DATE"

 +22       WRITE !!!,"________________________________________",?52,"__________________"

 +23       WRITE !?60,"DATE"

 +24       KILL AMHPG,AMHQUIT,AMHPRNM,AMHNODE,AMHPCNT,AMHFILE

 +25       QUIT 

HEAD      ;ENTRY POINT

 +1        IF 'AMHPG

               GOTO HEAD1

 +2        NEW X

 +3        IF '$GET(AMHBROW)

               IF $EXTRACT(IOST)="C"

                   IF IO=IO(0)

                       WRITE !

                       SET DIR(0)="EO"

                       DO ^DIR

                       KILL DIR

                       IF Y=0!(Y="^")!($DATA(DTOUT))

                           SET AMHQUIT=1

                           QUIT 

HEAD1     ;EP

 +1        IF $DATA(IOF)

               WRITE @IOF

           SET AMHPG=AMHPG+1

 +2        WRITE !?13,"********** CONFIDENTIAL PATIENT INFORMATION **********"

 +3        WRITE !,$TRANSLATE($JUSTIFY("",80)," ","*")

 +4        WRITE !,"*",?79,"*"

 +5        WRITE !,"*  INTAKE DOCUMENT",?45,"Printed: ",$$FMTE^XLFDT($$NOW^XLFDT),?79,"*"

 +6        WRITE !,"*  Name:  ",$PIECE(^DPT(DFN,0),U),?68,"Page ",AMHPG,?79,"*"

 +7        WRITE !,"*  ",$EXTRACT($PIECE(^DIC(4,DUZ(2),0),U),1,25),?30,"DOB:  ",$$FMTE^XLFDT($PIECE(^DPT(DFN,0),U,3),"2D"),?46,"Sex:  ",$PIECE(^DPT(DFN,0),U,2),?54,"  Chart #:  ",$PIECE(^AUTTLOC(DUZ(2),0),U,7),$PIECE($GET(^AUPNPAT(DFN,41,DUZ(2),0)),U,2),?

79,"*"

 +8        WRITE !,"*",?79,"*"

 +9        WRITE !,$TRANSLATE($JUSTIFY("",80)," ","*"),!

 +10       QUIT