APCDELAB.m

APCDELAB ; IHS/CMI/LAB - LAB LOG ENTRY ;

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

 ;

HDR ;

 W:$D(IOF) @IOF

 F APCDJ=1:1:5 S APCDX=$P($T(TEXT+APCDJ),";;",2) W !?80-$L(APCDX)\2,APCDX

 K APCDJ,APCDX

 W !!

 D ^APCDEIN

 Q:APCDFLG

 S APCDPAT="",APCDLAB=1

 S APCDLOC="" F  D GETLOC Q:APCDLOC=""  S APCDTYPE="" F  D GETTYPE Q:APCDTYPE=""  S APCDCAT="" F  D GETCAT Q:APCDCAT=""  D RESTOFIT

 D EOJ

 Q

 ;

RESTOFIT S APCDDATE="" F  D GETDATE Q:APCDDATE=""  S APCDPATE="" F  D RDPV Q:APCDPATE=""  D PROCESS

 Q

 ;

RDPV ; 

 S APCDPATE=""

 W !

 S DIR(0)="S^1:TEST TYPE;2:PATIENT",DIR("A")="Enter Lab Test Results By" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 Q:Y=""

 I $D(DUOUT)!($D(DTOUT)) Q

 S Y=$E(Y),APCDPATE=$S(Y=1:"T",Y=2:"P")

 Q

GETLOC ; GET LOCATION OF ENCOUNTER

 S APCDLOC=""

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

 Q:Y<0

 S APCDLOC=+Y

 Q

 ;

GETTYPE ; GET TYPE OF ENCOUNTER

 S APCDTYPE=""

 K DTOUT,DUOUT,DIRUT,DIROUT,DIR,DA

 S DIR(0)="9000010,.03O",DIR("A")="TYPE" D ^DIR K DIR

 I $D(DIRUT) S X="" Q

 S APCDTYPE=Y

 K DIR,DIRUT,DIROUT,DTOUT,DUOUT

 Q

 ;

 ;

GETCAT ; GET SERVICE CATEGORY

 S APCDCAT=""

 K DTOUT,DUOUT,DIRUT,DIROUT,DIR,DA

 S DIR(0)="9000010,.07O",DIR("A")="SERVICE CATEGORY" D ^DIR K DIR

 I $D(DIRUT) S X="" Q

 S APCDCAT=Y

 K DIR,DIRUT,DIROUT,DTOUT,DUOUT,DA,X,Y

 Q

 ;

GETDATE ; GET DATE

 W ! S APCDDATE="",%DT="AEPX",%DT("A")="Enter VISIT DATE: " D ^%DT

 Q:Y<0

 S APCDDATE=+Y

 K %DT("A")

 Q

 ;

 ;

PROCESS ; PROCESS MNEMONIC

 I APCDPATE="P" D LABLOG Q

 I APCDPATE="T" D LABTEST Q

 Q

 ;

GETPAT ; GET PATIENT

 D GETPAT^APCDEA

 Q:APCDPAT=""

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

 Q

 ;

LABLOG ;

 S X="LABLOG",DIC="^APCDTKW(",DIC(0)="",DIC("S")="I $L($P(^(0),U))>5" D ^DIC K DIC("B"),DIC("A"),DIC("S")

 I Y<0 W !!,$C(7),$C(7),"LAB LOG TEMPLATE MISSING, NOTIFY YOUR SUPERVISOR" Q

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

 S APCDPAT="" F  D GETPAT Q:APCDPAT=""  K APCDADD,APCDALVR D ^APCDEA2,GETMNEK

 Q

LABTEST ;

 S APCDLABT=""

 S X="LABTEST",DIC="^APCDTKW(",DIC(0)="",DIC("S")="I $L($P(^(0),U))>3" D ^DIC K DIC

 I Y<0 W !!,$C(7),$C(7),"LAB TEST TEMPLATE MISSING, NOTIFY YOUR SUPERVISOR" Q

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

 S DIC("A")="Enter LAB TEST type: ",DIC="^LAB(60,",DIC(0)="AEMQ" D ^DIC I Y<0 K DIC Q

 K DIC S APCDLABT="`"_+Y

 S APCDPAT="" F  D GETPAT Q:APCDPAT=""  K APCDADD,APCDALVR D ^APCDEA2,GETMNEK

 Q

GETMNEK ; KILL GETMNE SPECIFIC VARIABLES

 K APCDVSIT,APCDPATE

 Q

 ;

EOJ ; END OF JOB

 D ^APCDEKL

 K POP,X,Y,DI,DX,DQ,D,DIG,DIH,DIW,DK,DL,DLOUT

 K APCDLAB,APCDLABT,APCDPATE

 K %DT,%

 Q

 ;

TEXT ;

 ;;PCC Data Entry Module

 ;;

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

 ;;*   Lab Log ENTER Mode   *

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

 ;;

APCDELAB  ; IHS/CMI/LAB - LAB LOG ENTRY ;

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

 +2       ;

HDR       ;

 +1        IF $DATA(IOF)

               WRITE @IOF

 +2        FOR APCDJ=1:1:5

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

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

 +3        KILL APCDJ,APCDX

 +4        WRITE !!

 +5        DO ^APCDEIN

 +6        IF APCDFLG

               QUIT 

 +7        SET APCDPAT=""

           SET APCDLAB=1

 +8        SET APCDLOC=""

           FOR 

               DO GETLOC

               IF APCDLOC=""

                   QUIT 

               SET APCDTYPE=""

               FOR 

                   DO GETTYPE

                   IF APCDTYPE=""

                       QUIT 

                   SET APCDCAT=""

                   FOR 

                       DO GETCAT

                       IF APCDCAT=""

                           QUIT 

                       DO RESTOFIT

 +9        DO EOJ

 +10       QUIT 

 +11      ;

RESTOFIT   SET APCDDATE=""

           FOR 

               DO GETDATE

               IF APCDDATE=""

                   QUIT 

               SET APCDPATE=""

               FOR 

                   DO RDPV

                   IF APCDPATE=""

                       QUIT 

                   DO PROCESS

 +1        QUIT 

 +2       ;

RDPV      ; 

 +1        SET APCDPATE=""

 +2        WRITE !

 +3        SET DIR(0)="S^1:TEST TYPE;2:PATIENT"

           SET DIR("A")="Enter Lab Test Results By"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +4        IF Y=""

               QUIT 

 +5        IF $DATA(DUOUT)!($DATA(DTOUT))

               QUIT 

 +6        SET Y=$EXTRACT(Y)

           SET APCDPATE=$SELECT(Y=1:"T",Y=2:"P")

 +7        QUIT 

GETLOC    ; GET LOCATION OF ENCOUNTER

 +1        SET APCDLOC=""

 +2        SET DIC="^AUTTLOC("

           SET DIC(0)="AEMQ"

           DO ^DIC

           KILL DIC,DA

 +3        IF Y<0

               QUIT 

 +4        SET APCDLOC=+Y

 +5        QUIT 

 +6       ;

GETTYPE   ; GET TYPE OF ENCOUNTER

 +1        SET APCDTYPE=""

 +2        KILL DTOUT,DUOUT,DIRUT,DIROUT,DIR,DA

 +3        SET DIR(0)="9000010,.03O"

           SET DIR("A")="TYPE"

           DO ^DIR

           KILL DIR

 +4        IF $DATA(DIRUT)

               SET X=""

               QUIT 

 +5        SET APCDTYPE=Y

 +6        KILL DIR,DIRUT,DIROUT,DTOUT,DUOUT

 +7        QUIT 

 +8       ;

 +9       ;

GETCAT    ; GET SERVICE CATEGORY

 +1        SET APCDCAT=""

 +2        KILL DTOUT,DUOUT,DIRUT,DIROUT,DIR,DA

 +3        SET DIR(0)="9000010,.07O"

           SET DIR("A")="SERVICE CATEGORY"

           DO ^DIR

           KILL DIR

 +4        IF $DATA(DIRUT)

               SET X=""

               QUIT 

 +5        SET APCDCAT=Y

 +6        KILL DIR,DIRUT,DIROUT,DTOUT,DUOUT,DA,X,Y

 +7        QUIT 

 +8       ;

GETDATE   ; GET DATE

 +1        WRITE !

           SET APCDDATE=""

           SET %DT="AEPX"

           SET %DT("A")="Enter VISIT DATE: "

           DO ^%DT

 +2        IF Y<0

               QUIT 

 +3        SET APCDDATE=+Y

 +4        KILL %DT("A")

 +5        QUIT 

 +6       ;

 +7       ;

PROCESS   ; PROCESS MNEMONIC

 +1        IF APCDPATE="P"

               DO LABLOG

               QUIT 

 +2        IF APCDPATE="T"

               DO LABTEST

               QUIT 

 +3        QUIT 

 +4       ;

GETPAT    ; GET PATIENT

 +1        DO GETPAT^APCDEA

 +2        IF APCDPAT=""

               QUIT 

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

           IF AUPNDOB]""

               SET X2=AUPNDOB

               SET X1=APCDDATE

               DO ^%DTC

               SET AUPNDAYS=X

 +4        QUIT 

 +5       ;

LABLOG    ;

 +1        SET X="LABLOG"

           SET DIC="^APCDTKW("

           SET DIC(0)=""

           SET DIC("S")="I $L($P(^(0),U))>5"

           DO ^DIC

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

 +2        IF Y<0

               WRITE !!,$CHAR(7),$CHAR(7),"LAB LOG TEMPLATE MISSING, NOTIFY YOUR SUPERVISOR"

               QUIT 

 +3        SET APCDTPLT=+Y

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

 +4        SET APCDPAT=""

           FOR 

               DO GETPAT

               IF APCDPAT=""

                   QUIT 

               KILL APCDADD,APCDALVR

               DO ^APCDEA2

               DO GETMNEK

 +5        QUIT 

LABTEST   ;

 +1        SET APCDLABT=""

 +2        SET X="LABTEST"

           SET DIC="^APCDTKW("

           SET DIC(0)=""

           SET DIC("S")="I $L($P(^(0),U))>3"

           DO ^DIC

           KILL DIC

 +3        IF Y<0

               WRITE !!,$CHAR(7),$CHAR(7),"LAB TEST TEMPLATE MISSING, NOTIFY YOUR SUPERVISOR"

               QUIT 

 +4        SET APCDTPLT=+Y

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

 +5        SET DIC("A")="Enter LAB TEST type: "

           SET DIC="^LAB(60,"

           SET DIC(0)="AEMQ"

           DO ^DIC

           IF Y<0

               KILL DIC

               QUIT 

 +6        KILL DIC

           SET APCDLABT="`"_+Y

 +7        SET APCDPAT=""

           FOR 

               DO GETPAT

               IF APCDPAT=""

                   QUIT 

               KILL APCDADD,APCDALVR

               DO ^APCDEA2

               DO GETMNEK

 +8        QUIT 

GETMNEK   ; KILL GETMNE SPECIFIC VARIABLES

 +1        KILL APCDVSIT,APCDPATE

 +2        QUIT 

 +3       ;

EOJ       ; END OF JOB

 +1        DO ^APCDEKL

 +2        KILL POP,X,Y,DI,DX,DQ,D,DIG,DIH,DIW,DK,DL,DLOUT

 +3        KILL APCDLAB,APCDLABT,APCDPATE

 +4        KILL %DT,%

 +5        QUIT 

 +6       ;

TEXT      ;

 +1       ;;PCC Data Entry Module

 +2       ;;

 +3       ;;**************************

 +4       ;;*   Lab Log ENTER Mode   *

 +5       ;;**************************

 +6       ;;