AMHDPP.m

AMHDPP ; IHS/CMI/LAB - DISPLAY PATIENT PROFILE (HEALTH SUMMARY) ;

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

 ;

 ;

EN ;EP

 N DIC,DA,D0,X,Y

 I $G(AMHPAT)="" W !!,$C(7),$C(7),"Sorry I don't know the patient.",! Q

 D GETTYPE

 G:$G(APCHSTYP)="" XIT

 I $G(IO)="" S IOP="HOME" D ^%ZIS

 S APCHSPAT=AMHPAT

 S %="PCC Health Summary for "_$P(^DPT(APCHSPAT,0),U)

 D VIEWR^XBLM("EN^APCHS",%)

 K APCHSPAT,APCHSTYP,APCHSTAT,APCHSMTY,AMCHDAYS,AMCHDOB,%

 Q

XIT ;

 K %,Y,D0,X

 K APCHSPAT,APCHSTYP

 K APCHSTYP,APCHSPAT

 Q

GETTYPE ;

 D GETHSTYP^AMHVRL

 Q

 ;I $G(^AMHSITE(DUZ(2),0))="" D DEFAULT Q

 ;S APCHSTYP=$P(^AMHSITE(DUZ(2),0),U,4) I APCHSTYP="" D DEFAULT Q

 ;I '$D(^APCHSCTL(APCHSTYP)) W !,"Error in Site Parameter File!",$C(7),$C(7) S APCHSTYP="" Q

 ;Q

DEFAULT ;

 S APCHSTYP=""

 S DIC(0)="AEMQL",DIC="^APCHSCTL(" D ^DIC K DIC,DA

 I Y=-1 Q

 S APCHSTYP=+Y

 Q

AMHDPP    ; IHS/CMI/LAB - DISPLAY PATIENT PROFILE (HEALTH SUMMARY) ;

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

 +2       ;

 +3       ;

EN        ;EP

 +1        NEW DIC,DA,D0,X,Y

 +2        IF $GET(AMHPAT)=""

               WRITE !!,$CHAR(7),$CHAR(7),"Sorry I don't know the patient.",!

               QUIT 

 +3        DO GETTYPE

 +4        IF $GET(APCHSTYP)=""

               GOTO XIT

 +5        IF $GET(IO)=""

               SET IOP="HOME"

               DO ^%ZIS

 +6        SET APCHSPAT=AMHPAT

 +7        SET %="PCC Health Summary for "_$PIECE(^DPT(APCHSPAT,0),U)

 +8        DO VIEWR^XBLM("EN^APCHS",%)

 +9        KILL APCHSPAT,APCHSTYP,APCHSTAT,APCHSMTY,AMCHDAYS,AMCHDOB,%

 +10       QUIT 

XIT       ;

 +1        KILL %,Y,D0,X

 +2        KILL APCHSPAT,APCHSTYP

 +3        KILL APCHSTYP,APCHSPAT

 +4        QUIT 

GETTYPE   ;

 +1        DO GETHSTYP^AMHVRL

 +2        QUIT 

 +3       ;I $G(^AMHSITE(DUZ(2),0))="" D DEFAULT Q

 +4       ;S APCHSTYP=$P(^AMHSITE(DUZ(2),0),U,4) I APCHSTYP="" D DEFAULT Q

 +5       ;I '$D(^APCHSCTL(APCHSTYP)) W !,"Error in Site Parameter File!",$C(7),$C(7) S APCHSTYP="" Q

 +6       ;Q

DEFAULT   ;

 +1        SET APCHSTYP=""

 +2        SET DIC(0)="AEMQL"

           SET DIC="^APCHSCTL("

           DO ^DIC

           KILL DIC,DA

 +3        IF Y=-1

               QUIT 

 +4        SET APCHSTYP=+Y

 +5        QUIT