1 | ECED1 ;BIR/MAM,JPW-Event Capture Data Entry (cont'd) ;6 Mar 96
|
---|
2 | ;;2.0; EVENT CAPTURE ;**4,5,8,10,18,23,41,47,50,72**;8 May 96
|
---|
3 | CAT ;cat & set unit info
|
---|
4 | W !!,"Location: "_ECLN,!,"DSS Unit: "_ECDN,!
|
---|
5 | D CATS^ECHECK1
|
---|
6 | S NODE=$G(^ECD(ECD,0)),ECS=+$P(NODE,"^",2),ECM=+$P(NODE,"^",3),ECDDT=$P(NODE,"^",12),ECDDT=$S(ECDDT="T":"NOW",ECDDT="N":"NOW",1:"")
|
---|
7 | S ECSN=$S($P($G(^DIC(49,ECS,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN"),ECMN=$S($P($G(^ECC(723,ECM,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN")
|
---|
8 | S ECPCE="U~"_$S($P(NODE,"^",14)]"":$P(NODE,"^",14),1:"N")
|
---|
9 | PAT ;get pat
|
---|
10 | S (ECJLP,ECOUT)=0
|
---|
11 | K EC,^TMP("ECLKUP",$J) S CNT=0 K DIC S DIC=2,DIC(0)="QEAMZ",DIC("A")="Select Patient: " D ^DIC K DIC Q:Y<0 S ECDFN=+Y,ECPAT=$P(Y,"^",2),ECOUT=0
|
---|
12 | N ECUP S DFN=ECDFN D 2^VADPT I +VADM(6) D I $G(ECUP)="^" G PAT
|
---|
13 | . ; NOIS MWV-0603-21781: line below changed by VMP.
|
---|
14 | . W !!,"WARNING "_"[PATIENT DIED ON "_$P(VADM(6),U,2)_"] ",!!
|
---|
15 | . R "Press Return to Continue or ^ to Deselect: ",ECUP:DTIME
|
---|
16 | ASKD ;get proc date
|
---|
17 | D DATE Q:ECOUT
|
---|
18 | ;
|
---|
19 | ;- Determine inpatient/outpatient status
|
---|
20 | S ECPTSTAT=$$INOUTPT^ECUTL0(+$G(ECDFN),+$G(ECDT))
|
---|
21 | I ECPTSTAT="" D INOUTERR^ECUTL0 Q
|
---|
22 | ;
|
---|
23 | ;- Display inpatient/outpatient status message
|
---|
24 | D DSPSTAT^ECUTL0(ECPTSTAT) S ECIOFLG=1
|
---|
25 | ;
|
---|
26 | PR S X=$E(ECDT,1,7)-.0001 F I=0:0 S X=$O(^ECH("ADT",ECL,ECDFN,ECD,X)) Q:X>ECDT1!('X) S ECFN=0 F I=0:0 S ECFN=$O(^ECH("ADT",ECL,ECDFN,ECD,X,ECFN)) Q:'ECFN S CNT=CNT+1,EC(CNT)=ECFN D SET
|
---|
27 | S CNT=0 I '$O(EC(0))&ECOUT=99 S ECOUT=0 Q
|
---|
28 | PROS ; display procedures
|
---|
29 | I ECOUT K ECPAT D HDR W ! G PAT
|
---|
30 | I '$D(EC(1)) S ECJLP=1 D DATE Q:ECOUT D NEW^ECED2 S CNT=0 K EC G PR
|
---|
31 | ;
|
---|
32 | ;- Prevents inpat/outpat status from scrolling off screen before heading
|
---|
33 | ; clears screen and prints at top
|
---|
34 | I $D(EC(1)),(+$G(ECIOFLG)) D MSG1^ECMUTL1 K ECIOFLG
|
---|
35 | D HDR K ECHOICE F I=0:0 S CNT=$O(EC(CNT)) Q:'CNT!($D(ECHOICE)) S CNT1=CNT D LIST
|
---|
36 | I ECOUT K ECPAT D HDR W ! G PAT
|
---|
37 | I $D(ECHOICE),ECHOICE S EC=ECHOICE D EDIT^ECED3 S CNT=0 K EC G PR
|
---|
38 | I $D(ECHOICE),ECHOICE="N" S ECJLP=1 D DATE Q:ECOUT D NEW^ECED2 S CNT=0 K EC G PR
|
---|
39 | SELP W !!!,"Select a number to edit/delete, or enter N to create a New Procedure: " R X:DTIME I '$T!("^"[X) K ECPAT D HDR G PAT
|
---|
40 | I "Nn"[X S ECJLP=1 D DATE Q:ECOUT D NEW^ECED2 S CNT=0 K EC G PR
|
---|
41 | I '$D(EC(X)) W !!,"Enter N to create a new procedure, or the number corresponding to the",!,"procedure that you want to edit or delete. Enter ^ quit.",!!,"Press <RET> to continue " R X:DTIME S CNT=CNT1-5 G PROS
|
---|
42 | S EC=X D EDIT^ECED3 S CNT=0 K EC G PR
|
---|
43 | ;
|
---|
44 | LIST ; list procedures
|
---|
45 | I $Y+8>IOSL D SEL Q:$D(ECHOICE)!(X="")
|
---|
46 | S ECDTM=$$FMTE^XLFDT($P(EC(CNT),"^",10),2)
|
---|
47 | W !!,CNT_".",?5,"Category : "_$E($P(EC(CNT),"^",2),1,23),?41,"Pr. Date: ",ECDTM,?67,$P(EC(CNT),"^",4),!,?5,"Procedure: "_$E($P(EC(CNT),"^",3),1,50)_" ("_$P(EC(CNT),"^",6)_")",?67,$E($P(EC(CNT),"^",5),1,13)
|
---|
48 | I $O(EC(CNT,"MOD",""))'="" D
|
---|
49 | . N MOD S MOD="" F S MOD=$O(EC(CNT,"MOD",MOD)) Q:MOD="" D
|
---|
50 | . . W !?6,"Modifier: "," - ",MOD," ",$E(EC(CNT,"MOD",MOD),1,55)
|
---|
51 | I $P(EC(CNT),"^",9)]"" W !?5,"Procedure Reason: "_$P(EC(CNT),"^",9)
|
---|
52 | Q
|
---|
53 | HDR ; heading
|
---|
54 | W @IOF,!,"Location: "_ECLN,?40,"Service: "_ECSN,!,"Section: "_ECMN,?40,"DSS Unit: "_ECDN I $D(ECPAT) W !,"Patient: "_ECPAT,?40,"Procedure Date: "_ECDATE
|
---|
55 | Q
|
---|
56 | SEL ; select procedure
|
---|
57 | W !!!,"Select a number to edit, enter N for a New Procedure, or press <RET> to ",!,"continue listing procedures: " R X:DTIME I '$T!(X="^") S (ECOUT,ECHOICE)=1 Q
|
---|
58 | I X="" S CNT=CNT-1 D HDR Q
|
---|
59 | I "Na"[X S ECHOICE="N" Q
|
---|
60 | I $D(EC(X)) S ECHOICE=X Q
|
---|
61 | W !!,"To create a new procedure, type N. If you would like to edit or delete",!,"one of the procedures listed, enter the corresponding number. Press <RET>",!,"to continue the list, or ^ to quit."
|
---|
62 | W !!,"Press <RET> to continue " R X:DTIME S X="",CNT=CNT-6 D HDR
|
---|
63 | Q
|
---|
64 | SET ; set EC array
|
---|
65 | N ECPXD
|
---|
66 | I '$D(^ECH(EC(CNT),0)) W !!,"Event Capture patient data missing.",!! S ECOUT=1 Q
|
---|
67 | S ECCH=$G(^ECH(EC(CNT),0)),(ECPSYN,ECPTCD)="",ECDTM=$P(ECCH,"^",3)
|
---|
68 | S ECTEMP=+$P(ECCH,"^",8),ECCN=$S($P($G(^EC(726,ECTEMP,0)),"^")]"":$P(^(0),"^"),1:"None")
|
---|
69 | S ECTEMP=$P(ECCH,"^",9),ECTEST="^"_$P(ECTEMP,";",2),ECTEMP=+ECTEMP
|
---|
70 | I $P(ECCH,"^",4)'="",$P(ECCH,"^",7)'="",$P(ECCH,"^",8)'="",$P(ECCH,"^",9)'="" D
|
---|
71 | . S ECPSY=+$O(^ECJ("AP",$P(ECCH,"^",4),$P(ECCH,"^",7),$P(ECCH,"^",8),$P(ECCH,"^",9),""))
|
---|
72 | . I ECPSY'="" S ECPSYN=$P($G(^ECJ(ECPSY,"PRO")),"^",2)
|
---|
73 | S ECCPT=$S(ECTEST["EC":$P($G(^EC(725,ECTEMP,0)),"^",5),1:ECTEMP)
|
---|
74 | S (ECPTCD,ECPXD)="" I ECCPT'="" D
|
---|
75 | . S ECPXD=$$CPT^ICPTCOD(ECCPT,ECDTM) I +ECPXD>0 S ECPTCD=$P(ECPXD,U,2)
|
---|
76 | I $D(^ECH(EC(CNT),"MOD")) D K MOD,ARR,ECMODF
|
---|
77 | . K ARR,ECMOD S ECMODF=$$MOD^ECUTL(EC(CNT),"E",.ARR) I 'ECMODF Q
|
---|
78 | . S MOD="" F S MOD=$O(ARR(MOD)) Q:MOD="" S ECMOD(MOD)=$P(ARR(MOD),U,3)
|
---|
79 | I ECTEST["EC" D G SET1
|
---|
80 | . S ECPN=$S($P($G(^EC(725,ECTEMP,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN")
|
---|
81 | I ECTEST["ICPT" D G SET1
|
---|
82 | . S ECPN=$S($P(ECPXD,U,3)]"":$P(ECPXD,U,3),1:"UNKNOWN")
|
---|
83 | S ECPN="UNKNOWN"
|
---|
84 | SET1 S ECPN=ECPTCD_" "_ECPN_$S(ECPSYN="":"",1:" ["_ECPSYN_"]")
|
---|
85 | S ECTEMP=+$P(ECCH,"^",12)
|
---|
86 | S ECON=$S($P($G(^ECC(723,ECTEMP,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN")
|
---|
87 | S ECV=$P(ECCH,"^",10),EC4=$P(ECCH,"^",19),ECID=$P(ECCH,"^",20)
|
---|
88 | S EC4N=$S($P($G(^SC(+EC4,0)),"^")]"":$P(^(0),"^"),1:"")
|
---|
89 | S ECDAT=$$GETPPRV^ECPRVMUT(EC(CNT),.ECUN) I ECDAT S ECUN="^No primary provider"
|
---|
90 | S ECUN=$P(ECUN,"^",2)
|
---|
91 | ;
|
---|
92 | ;- Check for and display procedure reason
|
---|
93 | I +$P(ECCH,"^",23) S ECPRS=+$P(ECCH,"^",23),ECPRSL=$P($G(^ECL(ECPRS,0)),"^"),ECPRSN=$P($G(^ECR(ECPRSL,0)),"^")
|
---|
94 | S EC(CNT)=EC(CNT)_"^"_ECCN_"^"_ECPN_"^"_$S(ECUN[",":$P(ECUN,",")_", "_$E($P(ECUN,",",2)),1:ECUN)_"^"_$E(ECON,1,15)_"^"_ECV_"^"_EC4_"^"_ECID_$S($G(ECPRSN)]"":"^"_ECPRSN,1:"")
|
---|
95 | S $P(EC(CNT),"^",10)=ECDTM
|
---|
96 | I $O(ECMOD(""))'="" D
|
---|
97 | . M EC(CNT,"MOD")=ECMOD
|
---|
98 | K ECPRS,ECPRSN,ECPRSL,ECMOD
|
---|
99 | Q
|
---|
100 | DATE ;ask date
|
---|
101 | I ECJLP,$D(ECDT),$P(ECDT,".",2)]"" Q
|
---|
102 | I ECJLP,$D(ECDT),$P(ECDT,".",2)']"" W !!,"You must enter both DATE and TIME to create a new procedure record.",!!
|
---|
103 | ;
|
---|
104 | ;- Prevent future dates from being entered
|
---|
105 | K %DT S %DT="EAXR",%DT("A")="Enter Date and Time of Procedure: ",%DT(0)="-NOW" S:ECDDT]"" %DT("B")=ECDDT D ^%DT K %DT I Y<0 S ECOUT=1 Q
|
---|
106 | S ECDT=+Y,ECDT1=$E(Y,1,7)+.9999,ECDATE=$$FMTE^XLFDT(ECDT)
|
---|
107 | Q
|
---|