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