APCDERAD ; IHS/CMI/LAB - RAD 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="",APCDRAD=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="" D PROCESS
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
D RADLOG 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
;
RADLOG ;
S X="RADLOG",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),"RAD 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
GETMNEK ; KILL GETMNE SPECIFIC VARIABLES
K APCDVSIT
Q
;
EOJ ; END OF JOB
D ^APCDEKL
D KILL^AUPNPAT
K AGE,DFN
K POP,X,Y,DI,DX,DQ,D,DIG,DIH,DIW,DK,DL,DLOUT
K APCDRAD,APCDRADT
K %DT,%
Q
;
TEXT ;
;;PCC Data Entry Module
;;
;;********************************
;;* Radiology Log ENTER Mode *
;;********************************
;;
APCDERAD ; IHS/CMI/LAB - RAD 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 APCDRAD=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
DO PROCESS
+1 QUIT
+2 ;
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 DO RADLOG
QUIT
+2 QUIT
+3 ;
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 ;
RADLOG ;
+1 SET X="RADLOG"
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),"RAD 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
GETMNEK ; KILL GETMNE SPECIFIC VARIABLES
+1 KILL APCDVSIT
+2 QUIT
+3 ;
EOJ ; END OF JOB
+1 DO ^APCDEKL
+2 DO KILL^AUPNPAT
+3 KILL AGE,DFN
+4 KILL POP,X,Y,DI,DX,DQ,D,DIG,DIH,DIW,DK,DL,DLOUT
+5 KILL APCDRAD,APCDRADT
+6 KILL %DT,%
+7 QUIT
+8 ;
TEXT ;
+1 ;;PCC Data Entry Module
+2 ;;
+3 ;;********************************
+4 ;;* Radiology Log ENTER Mode *
+5 ;;********************************
+6 ;;
