AMHPL3.m

AMHPL3 ; IHS/CMI/LAB - NO DESCRIPTION PROVIDED ;

 ;;4.0;IHS BEHAVIORAL HEALTH;**2,4,5**;JUN 02, 2010;Build 18

 ;

 ;

 ;AMHP - problem ien

 ;AMHA - array name - not tested

 ; will pass back in AMHPL1(N)

P1(AMHP,AMHA) ;EP - send back array of one problem entry

 Q:'AMHP

 Q:'$D(^AUPNPROB(AMHP))

 I $G(AMHA)="" S AMHA="AMHPL1"

 K @AMHA

GATHER ;EP

 S AMHLINE=1,AMHX=""

 S AMHP0=^AUPNPROB(AMHP,0)

 S AMHX=$$SETSTR^VALM1(" Problem ID: ",AMHX,5,14),X=$S($P(^AUTTLOC($P(AMHP0,U,6),0),U,7)]"":$J($P(^(0),U,7),4),1:"??")_$P(AMHP0,U,7),AMHX=$$SETSTR^VALM1(X,AMHX,20,6)

 S AMHX=$$SETSTR^VALM1("DX:",AMHX,28,3),AMHX=$$SETSTR^VALM1($$VAL^XBDIQ1(9000011,APCDP,.01),AMHX,33,6),X="Status: "_$$EXTSET^XBFUNC(9000011,.12,$P(AMHP0,U,12)),AMHX=$$SETSTR^VALM1(X,AMHX,41,25)

 S AMHX=$$SETSTR^VALM1("Onset:",AMHX,65,6) I $P(AMHP0,U,13)]"" S AMHX=$$SETSTR^VALM1($$FDATE^VALM1($P(AMHP0,U,13)),AMHX,72,15)

 S @AMHA@(AMHLINE)=AMHX,AMHX=""

 S AMHLINE=AMHLINE+1,AMHX=$$GET1^DIQ(9000011,AMHP,.05),@AMHA@(AMHLINE)="      Provider Narrative:  "_AMHX

NOTE S AMHC=0 I $O(^AUPNPROB(AMHP,11,0)) D

 .S (AMHC,AMHL)=0 F  S AMHL=$O(^AUPNPROB(AMHP,11,AMHL)) Q:AMHL'=+AMHL  I $O(^AUPNPROB(AMHP,11,AMHL,11,0)) S AMHLR=$P(^AUTTLOC($P(^AUPNPROB(AMHP,11,AMHL,0),U),0),U,7) D

 ..S AMHX=0 F  S AMHX=$O(^AUPNPROB(AMHP,11,AMHL,11,AMHX)) Q:AMHX'=+AMHX  D

 ...S AMHC=AMHC+1 I AMHC=1 S X="        "_"Notes:" S AMHLINE=AMHLINE+1,@AMHA@(AMHLINE)=X

 ...S X="           "_AMHLR_" Note #"_$P(^AUPNPROB(AMHP,11,AMHL,11,AMHX,0),U)_"  "_$S($P(^(0),U,5)]"":$$FMTE^XLFDT($P(^(0),U,5),5),1:"        ")_"  "_$P(^AUPNPROB(AMHP,11,AMHL,11,AMHX,0),U,3)

 ...S AMHLINE=AMHLINE+1,@AMHA@(AMHLINE)=X

 Q

AMHPL3    ; IHS/CMI/LAB - NO DESCRIPTION PROVIDED ;

 +1       ;;4.0;IHS BEHAVIORAL HEALTH;**2,4,5**;JUN 02, 2010;Build 18

 +2       ;

 +3       ;

 +4       ;AMHP - problem ien

 +5       ;AMHA - array name - not tested

 +6       ; will pass back in AMHPL1(N)

P1(AMHP,AMHA) ;EP - send back array of one problem entry

 +1        IF 'AMHP

               QUIT 

 +2        IF '$DATA(^AUPNPROB(AMHP))

               QUIT 

 +3        IF $GET(AMHA)=""

               SET AMHA="AMHPL1"

 +4        KILL @AMHA

GATHER    ;EP

 +1        SET AMHLINE=1

           SET AMHX=""

 +2        SET AMHP0=^AUPNPROB(AMHP,0)

 +3        SET AMHX=$$SETSTR^VALM1(" Problem ID: ",AMHX,5,14)

           SET X=$SELECT($PIECE(^AUTTLOC($PIECE(AMHP0,U,6),0),U,7)]"":$JUSTIFY($PIECE(^(0),U,7),4),1:"??")_$PIECE(AMHP0,U,7)

           SET AMHX=$$SETSTR^VALM1(X,AMHX,20,6)

 +4        SET AMHX=$$SETSTR^VALM1("DX:",AMHX,28,3)

           SET AMHX=$$SETSTR^VALM1($$VAL^XBDIQ1(9000011,APCDP,.01),AMHX,33,6)

           SET X="Status: "_$$EXTSET^XBFUNC(9000011,.12,$PIECE(AMHP0,U,12))

           SET AMHX=$$SETSTR^VALM1(X,AMHX,41,25)

 +5        SET AMHX=$$SETSTR^VALM1("Onset:",AMHX,65,6)

           IF $PIECE(AMHP0,U,13)]""

               SET AMHX=$$SETSTR^VALM1($$FDATE^VALM1($PIECE(AMHP0,U,13)),AMHX,72,15)

 +6        SET @AMHA@(AMHLINE)=AMHX

           SET AMHX=""

 +7        SET AMHLINE=AMHLINE+1

           SET AMHX=$$GET1^DIQ(9000011,AMHP,.05)

           SET @AMHA@(AMHLINE)="      Provider Narrative:  "_AMHX

NOTE       SET AMHC=0

           IF $ORDER(^AUPNPROB(AMHP,11,0))

               Begin DoDot:1

 +1                SET (AMHC,AMHL)=0

                   FOR 

                       SET AMHL=$ORDER(^AUPNPROB(AMHP,11,AMHL))

                       IF AMHL'=+AMHL

                           QUIT 

                       IF $ORDER(^AUPNPROB(AMHP,11,AMHL,11,0))

                           SET AMHLR=$PIECE(^AUTTLOC($PIECE(^AUPNPROB(AMHP,11,AMHL,0),U),0),U,7)

                           Begin DoDot:2

 +2                            SET AMHX=0

                               FOR 

                                   SET AMHX=$ORDER(^AUPNPROB(AMHP,11,AMHL,11,AMHX))

                                   IF AMHX'=+AMHX

                                       QUIT 

                                   Begin DoDot:3

 +3                                    SET AMHC=AMHC+1

                                       IF AMHC=1

                                           SET X="        "_"Notes:"

                                           SET AMHLINE=AMHLINE+1

                                           SET @AMHA@(AMHLINE)=X

 +4                                    SET X="           "_AMHLR_" Note #"_$PIECE(^AUPNPROB(AMHP,11,AMHL,11,AMHX,0),U)_"  "_$SELECT($PIECE(^(0),U,5)]"":$$FMTE^XLFDT($PIECE(^(0),U,5),5),1:"        ")_"  "_$PIECE(^AUPNPROB(AMHP,11,AMHL,11,AMHX,0),U,3)

 +5                                    SET AMHLINE=AMHLINE+1

                                       SET @AMHA@(AMHLINE)=X

                                   End DoDot:3

                           End DoDot:2

               End DoDot:1

 +6        QUIT