APCDEAPC ; IHS/CMI/LAB - ENTRY OF DATA FROM APC FORMS ;
;;2.0;IHS PCC SUITE;**17**;MAY 14, 2009;Build 18
;FILE 200 CONV
;
;
;
HDR ; Write Header
W:$D(IOF) @IOF
F APCDJ=1:1:5 S APCDX=$P($T(TEXT+APCDJ),";;",2) W !?80-$L(APCDX)\2,APCDX
K APCDX,APCDJ
W !!
D ^APCDEIN S APCDTPLT=0
Q:APCDFLG
PROC ;
D GETLOC
G:APCDLOC="" EOJ
S APCDDATE="" F D GETDATE Q:APCDDATE="" F S APCDPAT="" D GETPAT Q:APCDPAT="" D PROCESS
D EOJ
Q
;
;
;
GETLOC ; GET LOCATION OF ENCOUNTER
S APCDLOC="",APCDTYPE="",APCDCAT=""
S APCDTYPE=$P(APCDPARM,U,11) I APCDTYPE="" W !!,"Default TYPE FOF VISIT NOT in Site Parameter File",$C(7),$C(7) H 4 Q
S APCDCAT="A"
S APCDLOC="" I $D(APCDDEFL),APCDDEFL]"" S DIC("B")=$P(^DIC(4,APCDDEFL,0),U)
S DIC("A")="Enter LOCATION of VISIT......: ",DIC="^AUTTLOC(",DIC(0)="AEMQ" D ^DIC K DIC
Q:Y<0
S APCDLOC=+Y
Q
;
;
GETDATE ; GET DATE OF ENCOUNTER
S APCDDATE=""
W !,"Enter VISIT DATE.............: " R X:$S($D(DTIME):DTIME,1:300) S:'$T X=""
Q:X=""!(X="^")
S %DT="ET" D ^%DT G:Y<0 GETDATE
I Y>DT W " <Future dates not allowed>",$C(7),$C(7) K X G GETDATE
S (APCDDATE,APCDHDAT)=Y
Q
GETPAT ; GET PATIENT
S APCDDATE=APCDHDAT
W:$D(IOF) @IOF W !!,"Entering forms for ",$P(^DIC(4,APCDLOC,0),U)," for visit date ",$$FMTE^XLFDT(APCDDATE,1)
S APCDPAT=""
S DIC("A")="Enter PATIENT NAME...........: ",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
I DUZ("AG")="I" D ^APCDEMDI I $D(^APCDSITE(DUZ(2),11)) D ^APCDECC
Q
;
PROCESS ; PROCESS PATIENT
TIME ;
S DIR(0)="SB^1:8AM - NOON;2:NOON - 5PM;3:5PM - 10PM;4:10PM - 8AM",DIR("A")="Enter TIME OF DAY" K DA D ^DIR K DIR
I $D(DIRUT) W !,"Time is required",!! Q
S APCDDATE=APCDDATE_"."_$S(Y=1:"08",Y=2:12,Y=3:17,Y=4:22,1:12)
CLINIC ;
K DIC S DIC(0)="AEMQ",DIC="^DIC(40.7,",DIC("A")="Enter TYPE OF CLINIC CODE....: " D ^DIC K DIC
I Y<0 W !!,"Clinic is required",!! H 2 Q
;S DIR(0)="9000010,.08",DIR("A")="Enter TYPE OF CLINIC CODE...." K DA D ^DIR K DIR
;I $D(DIRUT) W !!,"Clinic is required",!! Q
S APCDCLN="`"_+Y
D VISIT
Q
;
VISIT ; create visit
;W !!,"Creating PCC Visit for ",$P(^DPT(APCDPAT,0),U)," on ",$$FMTE^XLFDT(APCDDATE,"1P"),!!
S X=$$FMTE^XLFDT(APCDDATE,1) X $P(^DD(9000010,.01,0),U,5,99)
I '$D(X) W !!,"Visit information NOT correct for this patient.",!,$C(7),$C(7) H 3 Q
K APCDALVR
D ^APCDALV
I $D(APCDALVR("APCDAFLG")) W !!,$C(7),$C(7),"Visit creation failed!!",! Q
I '$G(APCDVSIT) W !!,"No visit selected!!" Q
;I $D(APCDVSIT("NEW")),$P(^APCCCTRL(DUZ(2),0),U,12)]"",$P($P(^AUPNVSIT(APCDVSIT,0),U),".")>$P(^APCCCTRL(DUZ(2),0),U,12) S DA=APCDVSIT,DIE="^AUPNVSIT(",DR="1111///R" D ^DIE K DIE,DA,DR
;above added for EHR and auditing of visits, d/e created
K APCDALVR
D PROVIDER
I '$$PRIMPROV^APCLV(APCDVSIT,"I") W !!,$C(7),$C(7),"Primary Provider Not Entered correctly. Deleting incomplete visit.",! H 5 D DELETE Q
D APCPOV
I '$$PRIMPOV^APCLV(APCDVSIT,"I") W !!,$C(7),$C(7),"Purpose of Visit Not Entered correctly. Deleting incomplete visit.",! H 5 D DELETE Q
D MNEPROC
Q
MNEPROC ; PROCESS MNEMONICS UNTIL DONE
W !!,"You may now enter any other information using the PCC mnemonics.",!
S APCDMPQ=0
F D GETMNE D:$D(APCDEQX) CHKEHR2^APCDVCHK I APCDMPQ Q
D GETMNEK
K APCDMPQ
Q
;
GETMNE ; GET MNEMONIC
W !
S DIC="^APCDTKW(",DIC(0)="AEMQ",DIC("A")="MNEMONIC: ",DIC("S")="I $L($P(^(0),U))<5" D ^DIC K DIC("A"),DIC("S")
I Y<0 D CHECK^APCDEGP0 Q
S APCDMNE=+Y,APCDMNE("NAME")=$P(Y,U,2)
K APCDMOD
D ^APCDEA3
I $D(APCDEQX) D ^APCDEQX I $D(APCDEQX) S APCDMPQ=1 Q
I $D(APCDMOD) W !!,"Switching to Modify Mode for ONE Mnemonic ONLY!" S APCDMODE="M",APCDVLK=APCDVSIT D GETMNE K APCDVLK,APCDMOD S APCDMODE="A" W !!,"Switching back to ENTER Mode!" Q
Q
;
GETMNEK ; KILL GETMNE SPECIFIC VARIABLES
K APCDVSIT,APCDEGX,APCDEQX
Q
APCPOV ;get APC RECODES AND FILE
K APCDALVR
S DIC="^AUTTRCD(",DIC(0)="AEMQ",DIC("A")="Enter APC CODE...............: " D ^DIC K DIC,DA
I Y=-1&((X="")!(X="^"))&('$$PRIMPOV^APCLV(APCDVSIT,"I")) G ICDPOV
Q:Y=-1
S APCDAPCC=$P(Y,U,2),APCDAPC=+Y I APCDAPCC>699&(APCDAPCC<800) D INJ
S APCDICD=$P(^AUTTRCD(APCDAPC,0),U,6) I APCDICD="" W !!,$C(7),$C(7),"NO ICD CODE ASSOCIATED WITH APC CODE ",APCDAPCC H 3 Q
S APCDALVR("APCDTPOV")=APCDICD
S APCDALVR("APCDVSIT")=APCDVSIT,APCDALVR("APCDATMP")="[APCDALVR 9000010.07 (ADD)]",APCDALVR("APCDPAT")=APCDPAT
S APCDALVR("APCDTNQ")=$P(^AUTTRCD(APCDAPC,0),U,3)
D ^APCDALVR
I $D(APCDALVR("APCDAFLG")) W !!,$C(7),$C(7),"Creating V Provider failed..."
G APCPOV
Q
ICDPOV ;
K APCDALVR
S DIC="^APCDTKW(",DIC(0)="E",X="IPV" D ^DIC K DIC,DA
I Y=-1 W !!,$C(7),$C(7),"Can't find IPV mnemonic!!",! H 4 Q
S APCDMNE=+Y,APCDMNE("NAME")=$P(Y,U,2)
D ^APCDEA3
Q
PROVIDER ;
X:$D(^DD(9000010.06,.01,12.1)) ^DD(9000010.06,.01,12.1)
S DIC=$S($P(^DD(9000010.06,.01,0),U,2)[200:"^VA(200,",1:"^DIC(6,"),DIC(0)="AEMQ",DIC("A")=$S('$$PRIMPROV^APCLV(APCDVSIT,"I"):"Enter PRIMARY Provider.......: ",1:"Enter OTHER Provider.........: ") D ^DIC K DIC
Q:Y=-1
PROV11 ;
S APCDALVR("APCDTPRO")="`"_+Y
S APCDALVR("APCDVSIT")=APCDVSIT,APCDALVR("APCDATMP")="[APCDALVR 9000010.06 (ADD)]",APCDALVR("APCDPAT")=APCDPAT
S APCDALVR("APCDTPS")=$S($$PRIMPROV^APCLV(APCDVSIT,"I"):"S",1:"P")
D ^APCDALVR
I $D(APCDALVR("APCDAFLG")) W !!,$C(7),$C(7),"Creating V Provider failed..."
G PROVIDER
Q
INJ ;
CAUSE ;
S DIC="^AUTTRIJ(",DIC(0)="AEMQ",DIC("A")="Enter EXTERNAL CAUSE OF INJURY: " D ^DIC K DA,DIC
I Y=-1 W !,"NO External Cause entered.",! G PLACE
S APCDALVR("APCDTCI")=$P(^AUTTRIJ(+Y,0),U,3)
S APCDALVR("APCDTFR")="F"
PLACE ;
S DIR(0)="9000010.07,.11",DIR("A")="Enter PLACE OF INJURY" K DA D ^DIR K DIR
G:$D(DIRUT) CAUSEDX
G:Y="" CAUSEDX
S APCDALVR("APCDTPA")=Y
CAUSEDX ;
S DIR(0)="9000010.07,.07",DIR("A")="Enter CAUSE OF DX (if alcohol related)" K DA D ^DIR K DIR
W !
Q:$D(DIRUT)
Q:Y=""
S APCDALVR("APCDTCD")=Y
Q
DELETE ;
S APCDVDLT=APCDVSIT D ^APCDVDLT
W !!,"Deleted.",!
Q
EOJ ; END OF JOB
D KILL^AUPNPAT
K APCDVSIT,APCDAPC,APCDAPCC,APCDHDAT,APCDDATE,APCDLOC,APCDTYPE,APCDCAT,APCDMNE,APCDALVR,APCDICD,APCDRV,APCDTCB,APCDTCM,APCDTORH
D ^APCDEKL
Q
TEXT ;
;;PCC Data Entry Module
;;
;;***********************
;;* APC FORM ENTRY Mode *
;;***********************
;;
APCDEAPC ; IHS/CMI/LAB - ENTRY OF DATA FROM APC FORMS ;
+1 ;;2.0;IHS PCC SUITE;**17**;MAY 14, 2009;Build 18
+2 ;FILE 200 CONV
+3 ;
+4 ;
+5 ;
HDR ; Write Header
+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 APCDX,APCDJ
+4 WRITE !!
+5 DO ^APCDEIN
SET APCDTPLT=0
+6 IF APCDFLG
QUIT
PROC ;
+1 DO GETLOC
+2 IF APCDLOC=""
GOTO EOJ
+3 SET APCDDATE=""
FOR
DO GETDATE
IF APCDDATE=""
QUIT
FOR
SET APCDPAT=""
DO GETPAT
IF APCDPAT=""
QUIT
DO PROCESS
+4 DO EOJ
+5 QUIT
+6 ;
+7 ;
+8 ;
GETLOC ; GET LOCATION OF ENCOUNTER
+1 SET APCDLOC=""
SET APCDTYPE=""
SET APCDCAT=""
+2 SET APCDTYPE=$PIECE(APCDPARM,U,11)
IF APCDTYPE=""
WRITE !!,"Default TYPE FOF VISIT NOT in Site Parameter File",$CHAR(7),$CHAR(7)
HANG 4
QUIT
+3 SET APCDCAT="A"
+4 SET APCDLOC=""
IF $DATA(APCDDEFL)
IF APCDDEFL]""
SET DIC("B")=$PIECE(^DIC(4,APCDDEFL,0),U)
+5 SET DIC("A")="Enter LOCATION of VISIT......: "
SET DIC="^AUTTLOC("
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC
+6 IF Y<0
QUIT
+7 SET APCDLOC=+Y
+8 QUIT
+9 ;
+10 ;
GETDATE ; GET DATE OF ENCOUNTER
+1 SET APCDDATE=""
+2 WRITE !,"Enter VISIT DATE.............: "
READ X:$SELECT($DATA(DTIME):DTIME,1:300)
IF '$TEST
SET X=""
+3 IF X=""!(X="^")
QUIT
+4 SET %DT="ET"
DO ^%DT
IF Y<0
GOTO GETDATE
+5 IF Y>DT
WRITE " <Future dates not allowed>",$CHAR(7),$CHAR(7)
KILL X
GOTO GETDATE
+6 SET (APCDDATE,APCDHDAT)=Y
+7 QUIT
GETPAT ; GET PATIENT
+1 SET APCDDATE=APCDHDAT
+2 IF $DATA(IOF)
WRITE @IOF
WRITE !!,"Entering forms for ",$PIECE(^DIC(4,APCDLOC,0),U)," for visit date ",$$FMTE^XLFDT(APCDDATE,1)
+3 SET APCDPAT=""
+4 SET DIC("A")="Enter PATIENT NAME...........: "
SET DIC="^AUPNPAT("
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC
+5 IF Y<0
QUIT
+6 IF $DATA(APCDPARM)
IF $PIECE(APCDPARM,U,3)="Y"
WRITE !?25,"Ok"
SET %=1
DO YN^DICN
IF %'=1
QUIT
+7 SET APCDPAT=+Y
+8 IF DUZ("AG")="I"
DO ^APCDEMDI
IF $DATA(^APCDSITE(DUZ(2),11))
DO ^APCDECC
+9 QUIT
+10 ;
PROCESS ; PROCESS PATIENT
TIME ;
+1 SET DIR(0)="SB^1:8AM - NOON;2:NOON - 5PM;3:5PM - 10PM;4:10PM - 8AM"
SET DIR("A")="Enter TIME OF DAY"
KILL DA
DO ^DIR
KILL DIR
+2 IF $DATA(DIRUT)
WRITE !,"Time is required",!!
QUIT
+3 SET APCDDATE=APCDDATE_"."_$SELECT(Y=1:"08",Y=2:12,Y=3:17,Y=4:22,1:12)
CLINIC ;
+1 KILL DIC
SET DIC(0)="AEMQ"
SET DIC="^DIC(40.7,"
SET DIC("A")="Enter TYPE OF CLINIC CODE....: "
DO ^DIC
KILL DIC
+2 IF Y<0
WRITE !!,"Clinic is required",!!
HANG 2
QUIT
+3 ;S DIR(0)="9000010,.08",DIR("A")="Enter TYPE OF CLINIC CODE...." K DA D ^DIR K DIR
+4 ;I $D(DIRUT) W !!,"Clinic is required",!! Q
+5 SET APCDCLN="`"_+Y
+6 DO VISIT
+7 QUIT
+8 ;
VISIT ; create visit
+1 ;W !!,"Creating PCC Visit for ",$P(^DPT(APCDPAT,0),U)," on ",$$FMTE^XLFDT(APCDDATE,"1P"),!!
+2 SET X=$$FMTE^XLFDT(APCDDATE,1)
XECUTE $PIECE(^DD(9000010,.01,0),U,5,99)
+3 IF '$DATA(X)
WRITE !!,"Visit information NOT correct for this patient.",!,$CHAR(7),$CHAR(7)
HANG 3
QUIT
+4 KILL APCDALVR
+5 DO ^APCDALV
+6 IF $DATA(APCDALVR("APCDAFLG"))
WRITE !!,$CHAR(7),$CHAR(7),"Visit creation failed!!",!
QUIT
+7 IF '$GET(APCDVSIT)
WRITE !!,"No visit selected!!"
QUIT
+8 ;I $D(APCDVSIT("NEW")),$P(^APCCCTRL(DUZ(2),0),U,12)]"",$P($P(^AUPNVSIT(APCDVSIT,0),U),".")>$P(^APCCCTRL(DUZ(2),0),U,12) S DA=APCDVSIT,DIE="^AUPNVSIT(",DR="1111///R" D ^DIE K DIE,DA,DR
+9 ;above added for EHR and auditing of visits, d/e created
+10 KILL APCDALVR
+11 DO PROVIDER
+12 IF '$$PRIMPROV^APCLV(APCDVSIT,"I")
WRITE !!,$CHAR(7),$CHAR(7),"Primary Provider Not Entered correctly. Deleting incomplete visit.",!
HANG 5
DO DELETE
QUIT
+13 DO APCPOV
+14 IF '$$PRIMPOV^APCLV(APCDVSIT,"I")
WRITE !!,$CHAR(7),$CHAR(7),"Purpose of Visit Not Entered correctly. Deleting incomplete visit.",!
HANG 5
DO DELETE
QUIT
+15 DO MNEPROC
+16 QUIT
MNEPROC ; PROCESS MNEMONICS UNTIL DONE
+1 WRITE !!,"You may now enter any other information using the PCC mnemonics.",!
+2 SET APCDMPQ=0
+3 FOR
DO GETMNE
IF $DATA(APCDEQX)
DO CHKEHR2^APCDVCHK
IF APCDMPQ
QUIT
+4 DO GETMNEK
+5 KILL APCDMPQ
+6 QUIT
+7 ;
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"
DO ^DIC
KILL DIC("A"),DIC("S")
+3 IF Y<0
DO CHECK^APCDEGP0
QUIT
+4 SET APCDMNE=+Y
SET APCDMNE("NAME")=$PIECE(Y,U,2)
+5 KILL APCDMOD
+6 DO ^APCDEA3
+7 IF $DATA(APCDEQX)
DO ^APCDEQX
IF $DATA(APCDEQX)
SET APCDMPQ=1
QUIT
+8 IF $DATA(APCDMOD)
WRITE !!,"Switching to Modify Mode for ONE Mnemonic ONLY!"
SET APCDMODE="M"
SET APCDVLK=APCDVSIT
DO GETMNE
KILL APCDVLK,APCDMOD
SET APCDMODE="A"
WRITE !!,"Switching back to ENTER Mode!"
QUIT
+9 QUIT
+10 ;
GETMNEK ; KILL GETMNE SPECIFIC VARIABLES
+1 KILL APCDVSIT,APCDEGX,APCDEQX
+2 QUIT
APCPOV ;get APC RECODES AND FILE
+1 KILL APCDALVR
+2 SET DIC="^AUTTRCD("
SET DIC(0)="AEMQ"
SET DIC("A")="Enter APC CODE...............: "
DO ^DIC
KILL DIC,DA
+3 IF Y=-1&((X="")!(X="^"))&('$$PRIMPOV^APCLV(APCDVSIT,"I"))
GOTO ICDPOV
+4 IF Y=-1
QUIT
+5 SET APCDAPCC=$PIECE(Y,U,2)
SET APCDAPC=+Y
IF APCDAPCC>699&(APCDAPCC<800)
DO INJ
+6 SET APCDICD=$PIECE(^AUTTRCD(APCDAPC,0),U,6)
IF APCDICD=""
WRITE !!,$CHAR(7),$CHAR(7),"NO ICD CODE ASSOCIATED WITH APC CODE ",APCDAPCC
HANG 3
QUIT
+7 SET APCDALVR("APCDTPOV")=APCDICD
+8 SET APCDALVR("APCDVSIT")=APCDVSIT
SET APCDALVR("APCDATMP")="[APCDALVR 9000010.07 (ADD)]"
SET APCDALVR("APCDPAT")=APCDPAT
+9 SET APCDALVR("APCDTNQ")=$PIECE(^AUTTRCD(APCDAPC,0),U,3)
+10 DO ^APCDALVR
+11 IF $DATA(APCDALVR("APCDAFLG"))
WRITE !!,$CHAR(7),$CHAR(7),"Creating V Provider failed..."
+12 GOTO APCPOV
+13 QUIT
ICDPOV ;
+1 KILL APCDALVR
+2 SET DIC="^APCDTKW("
SET DIC(0)="E"
SET X="IPV"
DO ^DIC
KILL DIC,DA
+3 IF Y=-1
WRITE !!,$CHAR(7),$CHAR(7),"Can't find IPV mnemonic!!",!
HANG 4
QUIT
+4 SET APCDMNE=+Y
SET APCDMNE("NAME")=$PIECE(Y,U,2)
+5 DO ^APCDEA3
+6 QUIT
PROVIDER ;
+1 IF $DATA(^DD(9000010.06,.01,12.1))
XECUTE ^DD(9000010.06,.01,12.1)
+2 SET DIC=$SELECT($PIECE(^DD(9000010.06,.01,0),U,2)[200:"^VA(200,",1:"^DIC(6,")
SET DIC(0)="AEMQ"
SET DIC("A")=$SELECT('$$PRIMPROV^APCLV(APCDVSIT,"I"):"Enter PRIMARY Provider.......: ",1:"Enter OTHER Provider.........: ")
DO ^DIC
KILL DIC
+3 IF Y=-1
QUIT
PROV11 ;
+1 SET APCDALVR("APCDTPRO")="`"_+Y
+2 SET APCDALVR("APCDVSIT")=APCDVSIT
SET APCDALVR("APCDATMP")="[APCDALVR 9000010.06 (ADD)]"
SET APCDALVR("APCDPAT")=APCDPAT
+3 SET APCDALVR("APCDTPS")=$SELECT($$PRIMPROV^APCLV(APCDVSIT,"I"):"S",1:"P")
+4 DO ^APCDALVR
+5 IF $DATA(APCDALVR("APCDAFLG"))
WRITE !!,$CHAR(7),$CHAR(7),"Creating V Provider failed..."
+6 GOTO PROVIDER
+7 QUIT
INJ ;
CAUSE ;
+1 SET DIC="^AUTTRIJ("
SET DIC(0)="AEMQ"
SET DIC("A")="Enter EXTERNAL CAUSE OF INJURY: "
DO ^DIC
KILL DA,DIC
+2 IF Y=-1
WRITE !,"NO External Cause entered.",!
GOTO PLACE
+3 SET APCDALVR("APCDTCI")=$PIECE(^AUTTRIJ(+Y,0),U,3)
+4 SET APCDALVR("APCDTFR")="F"
PLACE ;
+1 SET DIR(0)="9000010.07,.11"
SET DIR("A")="Enter PLACE OF INJURY"
KILL DA
DO ^DIR
KILL DIR
+2 IF $DATA(DIRUT)
GOTO CAUSEDX
+3 IF Y=""
GOTO CAUSEDX
+4 SET APCDALVR("APCDTPA")=Y
CAUSEDX ;
+1 SET DIR(0)="9000010.07,.07"
SET DIR("A")="Enter CAUSE OF DX (if alcohol related)"
KILL DA
DO ^DIR
KILL DIR
+2 WRITE !
+3 IF $DATA(DIRUT)
QUIT
+4 IF Y=""
QUIT
+5 SET APCDALVR("APCDTCD")=Y
+6 QUIT
DELETE ;
+1 SET APCDVDLT=APCDVSIT
DO ^APCDVDLT
+2 WRITE !!,"Deleted.",!
+3 QUIT
EOJ ; END OF JOB
+1 DO KILL^AUPNPAT
+2 KILL APCDVSIT,APCDAPC,APCDAPCC,APCDHDAT,APCDDATE,APCDLOC,APCDTYPE,APCDCAT,APCDMNE,APCDALVR,APCDICD,APCDRV,APCDTCB,APCDTCM,APCDTORH
+3 DO ^APCDEKL
+4 QUIT
TEXT ;
+1 ;;PCC Data Entry Module
+2 ;;
+3 ;;***********************
+4 ;;* APC FORM ENTRY Mode *
+5 ;;***********************
+6 ;;
