Routine: APCDENV

APCDENV ; IHS/CMI/LAB - ENTER NON-VISIT DATA ;

 ;;2.0;IHS PCC SUITE;**2**;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:7 S APCDX=$P($T(TEXT+APCDJ),";;",2) W !?80-$L(APCDX)\2,APCDX

 K APCDX,APCDJ

 W !!

 D ^APCDEIN

 Q:APCDFLG

 S APCDPAT="",APCDENV=1

 F APCDL=0:0 S APCDPAT="" D GETPAT Q:APCDPAT=""  F APCDL=0:0 S APCDLOC="" D GETLOC Q:APCDLOC=""  F APCDL=0:0 S APCDDATE="" D GETDATE Q:APCDDATE=""  F APCDL=0:0 D PROCESS Q:APCDEMF

 D EOJ

GETPAT ; GET PATIENT

 I APCDPAT S DIE="^AUPNPAT(",DR=".16///TODAY",DA=APCDPAT D ^DIE

W !

 S APCDPAT=""

 I '$P($G(^APCDSITE(DUZ(2),0)),U,34) S AUPNLK("INAC")=1

 S DIC="^AUPNPAT(",DIC(0)="AEMQ" D ^DIC K DIC

 Q:Y<0

 I $D(APCDPARM),$P(APCDPARM,U,3)="Y" W !?25,"Ok" S %=1 D YN^DICN Q:%'=1

 S APCDPAT=+Y

 D INAC^APCDEA(APCDPAT,.X) I 'X S APCDPAT="" Q

GETLOC ; GET LOCATION

 S APCDLOC="" S DIC="^AUTTLOC(",DIC(0)="AEMQ" D ^DIC K DIC

 Q:Y<0

 S APCDLOC=+Y

GETDATE ; GET DATE

 S APCDDATE="",%DT="AEPX",%DT("A")="Enter Date Information Was Collected: " D ^%DT

 Q:Y<0

 S APCDDATE=+Y

 I AUPNDOB]"" S X2=AUPNDOB,X1=APCDDATE D ^%DTC S AUPNDAYS=X ; re-set days of age to visit date-dob

PROCESS ; PROCESS MNEMONIC

 W !!,"Select non VISIT related mnemonics only!"

 D GETMNE

 K DIU,DIV S DIE="^AUPNPAT(",DR=".16///TODAY",DA=APCDPAT D ^DIE K DIV,DIU

 S APCDEMF=1

GETMNE ; GET MNEMONIC

W !

 S DIC="^APCDTKW(",DIC(0)="AEMQ",DIC("A")="MNEMONIC: ",DIC("S")="I $L($P(^(0),U))<5,'$P(^(0),U,8)" D ^DIC K DIC("A"),DIC("S")

 G:Y<0 GETMNEK

 S APCDMNE=+Y,APCDMNE("NAME")=$P(Y,U,2)

 D ^APCDEA3

 G GETMNE

GETMNEK ; KILL GETMNE SPECIFIC VARIABLES

 K APCDVSIT,APCDX

EOJ ; END OF JOB

 D ^APCDEKL

 K APCDENV

 K %DT,%W,%A,C,DI,DIG,DIH,DIPGM,DIW

TEXT ;

;;

 ;;PCC Data Entry Module

;;

 ;;*******************************

 ;;*   Entry of NON-VISIT Data   *

 ;;*******************************

;;

APCDENV   ; IHS/CMI/LAB - ENTER NON-VISIT DATA ;

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

 +2       ;

 +3       ; APCDFLG=0 ... RUN

 +4       ; APCDFLG=1 ... ERROR

 +5       ;

 +6       ; APCDMODE=A ... ADD

 +7       ; APCDMODE=M ... MOD

HDR       ; Write Header

 +1        IF $DATA(IOF)

               WRITE @IOF

 +2        FOR APCDJ=1:1:7

               SET APCDX=$PIECE($TEXT(TEXT+APCDJ),";;",2)

               WRITE !?80-$LENGTH(APCDX)\2,APCDX

 +3        KILL APCDX,APCDJ

 +4        WRITE !!

 +5       ;

 +6        DO ^APCDEIN

 +7        IF APCDFLG

               QUIT

 +8        SET APCDPAT=""

           SET APCDENV=1

 +9        FOR APCDL=0:0

               SET APCDPAT=""

               DO GETPAT

               IF APCDPAT=""

                   QUIT

               FOR APCDL=0:0

                   SET APCDLOC=""

                   DO GETLOC

                   IF APCDLOC=""

                       QUIT

                   FOR APCDL=0:0

                       SET APCDDATE=""

                       DO GETDATE

                       IF APCDDATE=""

                           QUIT

                       FOR APCDL=0:0

                           DO PROCESS

                           IF APCDEMF

                               QUIT

 +10       DO EOJ

 +11       QUIT

 +12      ;

GETPAT    ; GET PATIENT

 +1        IF APCDPAT

               SET DIE="^AUPNPAT("

               SET DR=".16///TODAY"

               SET DA=APCDPAT

               DO ^DIE

 +2        WRITE !

 +3        SET APCDPAT=""

 +4        IF '$PIECE($GET(^APCDSITE(DUZ(2),0)),U,34)

               SET AUPNLK("INAC")=1

 +5        SET DIC="^AUPNPAT("

           SET DIC(0)="AEMQ"

           DO ^DIC

           KILL DIC

 +6        IF Y<0

               QUIT

 +7        IF $DATA(APCDPARM)

               IF $PIECE(APCDPARM,U,3)="Y"

                   WRITE !?25,"Ok"

                   SET %=1

                   DO YN^DICN

                   IF %'=1

                       QUIT

 +8        SET APCDPAT=+Y

 +9        DO INAC^APCDEA(APCDPAT,.X)

           IF 'X

               SET APCDPAT=""

               QUIT

 +10       QUIT

 +11      ;

GETLOC    ; GET LOCATION

 +1        SET APCDLOC=""

           SET DIC="^AUTTLOC("

           SET DIC(0)="AEMQ"

           DO ^DIC

           KILL DIC

 +2        IF Y<0

               QUIT

 +3        SET APCDLOC=+Y

 +4        QUIT

 +5       ;

GETDATE   ; GET DATE

 +1        SET APCDDATE=""

           SET %DT="AEPX"

           SET %DT("A")="Enter Date Information Was Collected: "

           DO ^%DT

 +2        IF Y<0

               QUIT

 +3        SET APCDDATE=+Y

 +4       ; re-set days of age to visit date-dob

           IF AUPNDOB]""

               SET X2=AUPNDOB

               SET X1=APCDDATE

               DO ^%DTC

               SET AUPNDAYS=X

 +5        QUIT

 +6       ;

 +7       ;

PROCESS   ; PROCESS MNEMONIC

 +1        WRITE !!,"Select non VISIT related mnemonics only!"

 +2        DO GETMNE

 +3        KILL DIU,DIV

           SET DIE="^AUPNPAT("

           SET DR=".16///TODAY"

           SET DA=APCDPAT

           DO ^DIE

           KILL DIV,DIU

 +4        SET APCDEMF=1

 +5        QUIT

 +6       ;

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,'$P(^(0),U,8)"

           DO ^DIC

           KILL DIC("A"),DIC("S")

 +3        IF Y<0

               GOTO GETMNEK

 +4        SET APCDMNE=+Y

           SET APCDMNE("NAME")=$PIECE(Y,U,2)

 +5        DO ^APCDEA3

 +6        GOTO GETMNE

 +7       ;

 +8       ;

GETMNEK   ; KILL GETMNE SPECIFIC VARIABLES

 +1        KILL APCDVSIT,APCDX

 +2        QUIT

 +3       ;

EOJ       ; END OF JOB

 +1        DO ^APCDEKL

 +2        KILL APCDENV

 +3        KILL %DT,%W,%A,C,DI,DIG,DIH,DIPGM,DIW

 +4        QUIT

TEXT      ;

 +1       ;;

 +2       ;;PCC Data Entry Module

 +3       ;;

 +4       ;;*******************************

 +5       ;;*   Entry of NON-VISIT Data   *

 +6       ;;*******************************

 +7       ;;

APCDENV.m