APCDEHS1 ; 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 (DFN,Y)=APCHSPAT D ^AUPNPAT
K APCHSPAT,APCHSTYP,APCHSTAT,APCHSMTY,AMCHDAYS,AMCHDOB,APCDHDR
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("^APCDEHS1","AUPN*;VALM*")
K Y
Q
APCDEHS1 ; 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 DO EN^APCHS
+10 SET (DFN,Y)=APCHSPAT
DO ^AUPNPAT
+11 KILL APCHSPAT,APCHSTYP,APCHSTAT,APCHSMTY,AMCHDAYS,AMCHDOB,APCDHDR
+12 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("^APCDEHS1","AUPN*;VALM*")
+2 KILL Y
+3 QUIT