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