APCDEM.m

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       ;;***************