AMHPLK.m

AMHPLK ; IHS/CMI/LAB - LOOKUP PROBLEM ;

 ;;4.0;IHS BEHAVIORAL HEALTH;**2**;JUN 18, 2010;Build 23

 ;CALLED FROM AMH INPUT TEMPLATES

 ; Problem based on a problem # that is entered through data entry.

 S U="^",AMHPERR=""

 I AMHPR="?" W !,"Enter a Problem Number." S AMHPERR=1 Q

 I AMHPR="??" W !,"Enter a Problem Number." S AMHPERR=1 Q

 S AMHPN=AMHPR I AMHPN<1!(AMHPN>999.99) W !,"Invalid problem number" S AMHPERR=1 Q

 S AMHPN=" "_$E("000",1,(3-$L($P(AMHPN,"."))))_$P(AMHPN,".")_"."_$P(AMHPN,".",2)_$E("00",1,(2-$L($P(AMHPN,".",2))))

 I '$D(^AMHPPROB("AA",AMHPAT,AMHPN)) W !,"No Problem Number ",AMHPN," on file for this patient" S AMHPERR=1 Q

 S AMHPDFN="",AMHPDFN=$O(^AMHPPROB("AA",AMHPAT,AMHPN,AMHPDFN))

 S AMHPDFN="`"_AMHPDFN

 K AMHPLOC,AMHPN,AMHPI,AMHPN,AMHPPL,AMHPL,AMHPSUB

 Q

LL ;

 N DIC,DA,D,DZ S DIC="^AUTTLOC(",DIC(0)="E",D="D",DZ="??" D DQ^DICQ K Y,DIC,D

 Q

AMHPLK    ; IHS/CMI/LAB - LOOKUP PROBLEM ;

 +1       ;;4.0;IHS BEHAVIORAL HEALTH;**2**;JUN 18, 2010;Build 23

 +2       ;CALLED FROM AMH INPUT TEMPLATES

 +3       ; Problem based on a problem # that is entered through data entry.

 +4        SET U="^"

           SET AMHPERR=""

 +5        IF AMHPR="?"

               WRITE !,"Enter a Problem Number."

               SET AMHPERR=1

               QUIT 

 +6        IF AMHPR="??"

               WRITE !,"Enter a Problem Number."

               SET AMHPERR=1

               QUIT 

 +7        SET AMHPN=AMHPR

           IF AMHPN<1!(AMHPN>999.99)

               WRITE !,"Invalid problem number"

               SET AMHPERR=1

               QUIT 

 +8        SET AMHPN=" "_$EXTRACT("000",1,(3-$LENGTH($PIECE(AMHPN,"."))))_$PIECE(AMHPN,".")_"."_$PIECE(AMHPN,".",2)_$EXTRACT("00",1,(2-$LENGTH($PIECE(AMHPN,".",2))))

 +9        IF '$DATA(^AMHPPROB("AA",AMHPAT,AMHPN))

               WRITE !,"No Problem Number ",AMHPN," on file for this patient"

               SET AMHPERR=1

               QUIT 

 +10       SET AMHPDFN=""

           SET AMHPDFN=$ORDER(^AMHPPROB("AA",AMHPAT,AMHPN,AMHPDFN))

 +11       SET AMHPDFN="`"_AMHPDFN

 +12       KILL AMHPLOC,AMHPN,AMHPI,AMHPN,AMHPPL,AMHPL,AMHPSUB

 +13       QUIT 

LL        ;

 +1        NEW DIC,DA,D,DZ

           SET DIC="^AUTTLOC("

           SET DIC(0)="E"

           SET D="D"

           SET DZ="??"

           DO DQ^DICQ

           KILL Y,DIC,D

 +2        QUIT