APCDEM ; IHS/CMI/LAB - MODIFY MODE ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;
; APCDFLG=0 ... RUN
; APCDFLG=1 ... ERROR
;
; APCDMODE=A ... ADD
; APCDMODE=M ... MOD
;
HDR ; Write Header
W:$D(IOF) @IOF
F APCDJ=1:1:5 S APCDX=$T(TEXT+APCDJ),APCDX=$P(APCDX,";;",2) W !?80-$L(APCDX)\2,APCDX K APCDX
K APCDX,APCDJ
W !!
D ^APCDEIN S APCDMODE="M"
Q:APCDFLG
F APCDL=0:0 D GETPAT Q:APCDPAT="" F APCDL=0:0 S APCDVSIT="" D GETVISIT Q:'APCDVSIT D PROCESS Q
D EOJ
Q
;
GETPAT ; GET PATIENT
W !
S APCDPAT=""
S DIC="^AUPNPAT(",DIC(0)="AEMQ" D ^DIC K DIC
Q:Y<0
S APCDPAT=+Y
I DUZ("AG")="I" D ^APCDEMDI
Q
;
GETVISIT ;
S APCDLOOK="",APCDVSIT="",APCDEMF=0
K APCDVLK
S DIR(0)="Y",DIR("A")="VISIT related",DIR("B")="YES" D ^DIR K DIR Q:$D(DIRUT) S APCDX=Y
I APCDX=1 D ^APCDVLK
I APCDLOOK S AUPNVSIT=APCDLOOK D MOD^AUPNVSIT
I APCDLOOK="",APCDX=1 W !!,"No Visit Selected!!",$C(7),$C(7),! G GETVISIT
I APCDLOOK="" S APCDLOOK=-1,APCDEMF=1 W !!,"Select non VISIT related mnemonics only!"
S (APCDVSIT,APCDVLK)=APCDLOOK
I AUPNDOB]"",$D(APCDDATE) S X2=AUPNDOB,X1=APCDDATE D ^%DTC S AUPNDAYS=X ; re-set days of age to visit date-dob
K APCDLOOK
Q
;
PROCESS ;EP PROCESS MNEMONIC
D GETMNE
S DIE="^AUPNPAT(",DR=".16///TODAY",DA=APCDPAT D ^DIE
Q
;
GETMNE ; GET MNEMONIC
W !
S DIC="^APCDTKW(",DIC(0)="AEMQ",DIC("A")="MNEMONIC: ",DIC("S")="I $L($P(^(0),U))<5" D ^DIC K DIC
G:Y<0 GETMNEK
S APCDMNE=+Y,APCDMNE("NAME")=$P(Y,U,2)
D ^APCDEA3
G GETMNE
;
GETMNEK ; KILL GETMNE SPECIFIC VARIABLES
D:APCDVSIT>0 CHECK
I $G(APCDVSIT) D EP^APCDKDE
K APCDVSIT,APCDX
Q
;
CHECK ; SEE IF PV AND PRO ENTERED CORRECTLY
D ^APCDVCHK
S APCDMNE=0
Q
;
EOJ ; END OF JOB
D ^APCDEKL
Q
TEXT ;
;;PCC Data Entry Module
;;
;;***************
;;* MODIFY Mode *
;;***************
APCDEM ; IHS/CMI/LAB - MODIFY MODE ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;
+3 ; APCDFLG=0 ... RUN
+4 ; APCDFLG=1 ... ERROR
+5 ;
+6 ; APCDMODE=A ... ADD
+7 ; APCDMODE=M ... MOD
+8 ;
HDR ; Write Header
+1 IF $DATA(IOF)
WRITE @IOF
+2 FOR APCDJ=1:1:5
SET APCDX=$TEXT(TEXT+APCDJ)
SET APCDX=$PIECE(APCDX,";;",2)
WRITE !?80-$LENGTH(APCDX)\2,APCDX
KILL APCDX
+3 KILL APCDX,APCDJ
+4 WRITE !!
+5 DO ^APCDEIN
SET APCDMODE="M"
+6 IF APCDFLG
QUIT
+7 FOR APCDL=0:0
DO GETPAT
IF APCDPAT=""
QUIT
FOR APCDL=0:0
SET APCDVSIT=""
DO GETVISIT
IF 'APCDVSIT
QUIT
DO PROCESS
QUIT
+8 DO EOJ
+9 QUIT
+10 ;
GETPAT ; GET PATIENT
+1 WRITE !
+2 SET APCDPAT=""
+3 SET DIC="^AUPNPAT("
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC
+4 IF Y<0
QUIT
+5 SET APCDPAT=+Y
+6 IF DUZ("AG")="I"
DO ^APCDEMDI
+7 QUIT
+8 ;
GETVISIT ;
+1 SET APCDLOOK=""
SET APCDVSIT=""
SET APCDEMF=0
+2 KILL APCDVLK
+3 SET DIR(0)="Y"
SET DIR("A")="VISIT related"
SET DIR("B")="YES"
DO ^DIR
KILL DIR
IF $DATA(DIRUT)
QUIT
SET APCDX=Y
+4 IF APCDX=1
DO ^APCDVLK
+5 IF APCDLOOK
SET AUPNVSIT=APCDLOOK
DO MOD^AUPNVSIT
+6 IF APCDLOOK=""
IF APCDX=1
WRITE !!,"No Visit Selected!!",$CHAR(7),$CHAR(7),!
GOTO GETVISIT
+7 IF APCDLOOK=""
SET APCDLOOK=-1
SET APCDEMF=1
WRITE !!,"Select non VISIT related mnemonics only!"
+8 SET (APCDVSIT,APCDVLK)=APCDLOOK
+9 ; re-set days of age to visit date-dob
IF AUPNDOB]""
IF $DATA(APCDDATE)
SET X2=AUPNDOB
SET X1=APCDDATE
DO ^%DTC
SET AUPNDAYS=X
+10 KILL APCDLOOK
+11 QUIT
+12 ;
PROCESS ;EP PROCESS MNEMONIC
+1 DO GETMNE
+2 SET DIE="^AUPNPAT("
SET DR=".16///TODAY"
SET DA=APCDPAT
DO ^DIE
+3 QUIT
+4 ;
GETMNE ; GET MNEMONIC
+1 WRITE !
+2 SET DIC="^APCDTKW("
SET DIC(0)="AEMQ"
SET DIC("A")="MNEMONIC: "
SET DIC("S")="I $L($P(^(0),U))<5"
DO ^DIC
KILL DIC
+3 IF Y<0
GOTO GETMNEK
+4 SET APCDMNE=+Y
SET APCDMNE("NAME")=$PIECE(Y,U,2)
+5 DO ^APCDEA3
+6 GOTO GETMNE
+7 ;
GETMNEK ; KILL GETMNE SPECIFIC VARIABLES
+1 IF APCDVSIT>0
DO CHECK
+2 IF $GET(APCDVSIT)
DO EP^APCDKDE
+3 KILL APCDVSIT,APCDX
+4 QUIT
+5 ;
CHECK ; SEE IF PV AND PRO ENTERED CORRECTLY
+1 DO ^APCDVCHK
+2 SET APCDMNE=0
+3 QUIT
+4 ;
EOJ ; END OF JOB
+1 DO ^APCDEKL
+2 QUIT
TEXT ;
+1 ;;PCC Data Entry Module
+2 ;;
+3 ;;***************
+4 ;;* MODIFY Mode *
+5 ;;***************
