APCDPL3.m

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

 ;;2.0;IHS PCC SUITE;**5,10,11**;MAY 14, 2009;Build 58

 ;

 ;

 ;APCDP - problem ien

 ;APCDA - array name - not tested

 ; will pass back in APCDPL1(N)

P1(APCDP,APCDA) ;EP - send back array of one problem entry

 Q:'APCDP

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

 I $G(APCDA)="" S APCDA="APCDPL1"

 K @APCDA

GATHER ;EP

 S APCDLINE=1,APCDX=""

 S APCDP0=^AUPNPROB(APCDP,0)

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

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

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

 S @APCDA@(APCDLINE)=APCDX,APCDX=""

 S APCDLINE=APCDLINE+1,APCDX=$$VAL^XBDIQ1(9000011,APCDP,.05),@APCDA@(APCDLINE)="      Provider Narrative:  "_APCDX

NOTE S APCDC=0 I $O(^AUPNPROB(APCDP,11,0)) D

 .S (APCDC,APCDL)=0 F  S APCDL=$O(^AUPNPROB(APCDP,11,APCDL)) Q:APCDL'=+APCDL  I $O(^AUPNPROB(APCDP,11,APCDL,11,0)) S APCDLR=$P(^AUTTLOC($P(^AUPNPROB(APCDP,11,APCDL,0),U),0),U,7) D

 ..S APCDX=0 F  S APCDX=$O(^AUPNPROB(APCDP,11,APCDL,11,APCDX)) Q:APCDX'=+APCDX  D

 ...S APCDC=APCDC+1 I APCDC=1 S X="        "_"Notes:" S APCDLINE=APCDLINE+1,@APCDA@(APCDLINE)=X

 ...S X="           "_APCDLR_" Note #"_$P(^AUPNPROB(APCDP,11,APCDL,11,APCDX,0),U)_"  "_$S($P(^(0),U,5)]"":$$FMTE^XLFDT($P(^(0),U,5),5),1:"        ")_"  "_$P(^AUPNPROB(APCDP,11,APCDL,11,APCDX,0),U,3)

 ...S APCDLINE=APCDLINE+1,@APCDA@(APCDLINE)=X

 Q

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

 +1       ;;2.0;IHS PCC SUITE;**5,10,11**;MAY 14, 2009;Build 58

 +2       ;

 +3       ;

 +4       ;APCDP - problem ien

 +5       ;APCDA - array name - not tested

 +6       ; will pass back in APCDPL1(N)

P1(APCDP,APCDA) ;EP - send back array of one problem entry

 +1        IF 'APCDP

               QUIT 

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

               QUIT 

 +3        IF $GET(APCDA)=""

               SET APCDA="APCDPL1"

 +4        KILL @APCDA

GATHER    ;EP

 +1        SET APCDLINE=1

           SET APCDX=""

 +2        SET APCDP0=^AUPNPROB(APCDP,0)

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

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

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

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

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

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

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

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

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

               SET APCDX=$$SETSTR^VALM1($$FDATE^VALM1($PIECE(APCDP0,U,13)),APCDX,72,15)

 +6        SET @APCDA@(APCDLINE)=APCDX

           SET APCDX=""

 +7        SET APCDLINE=APCDLINE+1

           SET APCDX=$$VAL^XBDIQ1(9000011,APCDP,.05)

           SET @APCDA@(APCDLINE)="      Provider Narrative:  "_APCDX

NOTE       SET APCDC=0

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

               Begin DoDot:1

 +1                SET (APCDC,APCDL)=0

                   FOR 

                       SET APCDL=$ORDER(^AUPNPROB(APCDP,11,APCDL))

                       IF APCDL'=+APCDL

                           QUIT 

                       IF $ORDER(^AUPNPROB(APCDP,11,APCDL,11,0))

                           SET APCDLR=$PIECE(^AUTTLOC($PIECE(^AUPNPROB(APCDP,11,APCDL,0),U),0),U,7)

                           Begin DoDot:2

 +2                            SET APCDX=0

                               FOR 

                                   SET APCDX=$ORDER(^AUPNPROB(APCDP,11,APCDL,11,APCDX))

                                   IF APCDX'=+APCDX

                                       QUIT 

                                   Begin DoDot:3

 +3                                    SET APCDC=APCDC+1

                                       IF APCDC=1

                                           SET X="        "_"Notes:"

                                           SET APCDLINE=APCDLINE+1

                                           SET @APCDA@(APCDLINE)=X

 +4                                    SET X="           "_APCDLR_" Note #"_$PIECE(^AUPNPROB(APCDP,11,APCDL,11,APCDX,0),U)_"  "_$SELECT($PIECE(^(0),U,5)]"":$$FMTE^XLFDT($PIECE(^(0),U,5),5),1:"        ")_"  "_$PIECE(^AUPNPROB(APCDP,11,APCDL,11,APCDX,0),U,3

)

 +5                                    SET APCDLINE=APCDLINE+1

                                       SET @APCDA@(APCDLINE)=X

                                   End DoDot:3

                           End DoDot:2

               End DoDot:1

 +6        QUIT