APCDEHS.m

APCDEHS ; IHS/CMI/LAB - HS IN DATA ENTRY ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 ;

 N DIC,DA,D0,X,Y,DP,DI,DL

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

 D GETTYPE

 G:APCHSTYP="" XIT

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

 S APCHSPAT=AUPNPAT

 ;D EN^APCHS

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

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

 S (DFN,Y)=APCHSPAT D ^AUPNPAT

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

 D FULL^VALM1

 Q

XIT ;

 K %,Y

 K APCHSTYP,APCHSPAT

 Q

GETTYPE ;

 I $G(AUPNPARM)="" D DEFAULT Q

 S APCHSTYP=$P(AUPNPARM,U,14) 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 X="ADULT REGULAR",DIC(0)="",DIC="^APCHSCTL(" D ^DIC K DIC,DA

 I Y=-1 W !!,"PCC DATA ENTRY HEALTH SUMMARY TYPE IS MISSING!!  NOTIFY YOUR SUPERVISOR OR SITE MANAGER.",!! Q

 S APCHSTYP=+Y

 Q

EPDE ;EP - CALLED FROM D/E TEMPLATE

 D EN^XBNEW("^APCDEHS","AUPN*;VALM*")

 K Y

 Q

APCDEHS   ; IHS/CMI/LAB - HS IN DATA ENTRY ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 +2       ;

 +3        NEW DIC,DA,D0,X,Y,DP,DI,DL

 +4        IF $GET(AUPNPAT)=""

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

               QUIT 

 +5        DO GETTYPE

 +6        IF APCHSTYP=""

               GOTO XIT

 +7        IF $GET(IO)=""

               SET IOP="HOME"

               DO ^%ZIS

 +8        SET APCHSPAT=AUPNPAT

 +9       ;D EN^APCHS

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

 +11       DO VIEWR^XBLM("EN^APCHS",APCDHDR)

 +12       SET (DFN,Y)=APCHSPAT

           DO ^AUPNPAT

 +13       KILL APCHSPAT,APCHSTYP,APCHSTAT,APCHSMTY,AMCHDAYS,AMCHDOB,APCDHDR

 +14       DO FULL^VALM1

 +15       QUIT 

XIT       ;

 +1        KILL %,Y

 +2        KILL APCHSTYP,APCHSPAT

 +3        QUIT 

GETTYPE   ;

 +1        IF $GET(AUPNPARM)=""

               DO DEFAULT

               QUIT 

 +2        SET APCHSTYP=$PIECE(AUPNPARM,U,14)

           IF APCHSTYP=""

               DO DEFAULT

               QUIT 

 +3        IF '$DATA(^APCHSCTL(APCHSTYP))

               WRITE !,"Error in Site Parameter File!",$CHAR(7),$CHAR(7)

               SET APCHSTYP=""

               QUIT 

 +4        QUIT 

DEFAULT   ;

 +1        SET APCHSTYP=""

 +2        SET X="ADULT REGULAR"

           SET DIC(0)=""

           SET DIC="^APCHSCTL("

           DO ^DIC

           KILL DIC,DA

 +3        IF Y=-1

               WRITE !!,"PCC DATA ENTRY HEALTH SUMMARY TYPE IS MISSING!!  NOTIFY YOUR SUPERVISOR OR SITE MANAGER.",!!

               QUIT 

 +4        SET APCHSTYP=+Y

 +5        QUIT 

EPDE      ;EP - CALLED FROM D/E TEMPLATE

 +1        DO EN^XBNEW("^APCDEHS","AUPN*;VALM*")

 +2        KILL Y

 +3        QUIT