[613] | 1 | ECBEN1B ;BIR/MAM,JPW-Batch Enter Procedures (cont'd) ;1 May 96
|
---|
| 2 | ;;2.0; EVENT CAPTURE ;**4,5,10,13,17,23,41,42,50,54,72**;8 May 96
|
---|
| 3 | EN ;entry pt
|
---|
| 4 | D HDR
|
---|
| 5 | S CNT=0
|
---|
| 6 | PATS ; get patients
|
---|
| 7 | W ! Q:ECOUT=1 K ECADD
|
---|
| 8 | K DIC,DUOUT S DIC=2,DIC(0)="QEAMZ",DIC("A")=$S($D(ECPT):"Select Next Patient: ",1:"Select Patient: ")
|
---|
| 9 | D ^DIC K DIC S OK=0
|
---|
| 10 | I $D(DUOUT)!($D(DTOUT)) S ECOUT=1 Q
|
---|
| 11 | I Y<0,CNT=0 S ECOUT=2 Q
|
---|
| 12 | I Y<0 D G PATS
|
---|
| 13 | .D LIST Q:ECOUT=1 Q:'$O(ECPT(0)) Q:$G(ECADD)="A"
|
---|
| 14 | .S ECTWO=0 K ECHOICE D ^ECBEN2A
|
---|
| 15 | .I ECOUT=2 D KILL,HDR
|
---|
| 16 | I $O(ECPT(0)) S JJ="" F S JJ=$O(ECPT(JJ)) Q:'JJ!(OK=1) I +$G(ECPT(JJ))=+Y S OK=1 W !!,"Patient already selected. Please select another patient.",!
|
---|
| 17 | I OK=1 G PATS
|
---|
| 18 | N YY,ECUP D I $G(ECUP)="^" G PATS
|
---|
| 19 | . S YY=Y,DFN=+Y D 2^VADPT S Y=YY I +VADM(6) D
|
---|
| 20 | . . ; NOIS MWV-0603-21781:line below changed by VMP.
|
---|
| 21 | . . W !!,"WARNING "_"[PATIENT DIED ON "_$P(VADM(6),U,2)_"] ",!!
|
---|
| 22 | . . R "Press Return to Continue or ^ to Deselect: ",ECUP:DTIME
|
---|
| 23 | S CNT=CNT+1,CNT1=CNT,ECPT(CNT)=+Y_"^"_$P(Y,"^",2) D DIAG
|
---|
| 24 | G PATS
|
---|
| 25 | ;
|
---|
| 26 | LIST ; list patients
|
---|
| 27 | K ECADD
|
---|
| 28 | W @IOF,!,"Patients Selected for Batch Entry: ",! F I=0:0 S I=$O(ECPT(I)) Q:'I W:I#2 ! W:I#2=0 ?40 W I_". "_$P(ECPT(I),"^",2)
|
---|
| 29 | W !!,"Is this list correct ? YES// " R ECYN:DTIME I '$T!(ECYN="^") S ECOUT=1 Q
|
---|
| 30 | S ECYN=$E(ECYN) S:ECYN="" ECYN="Y" I "YyNn"'[ECYN W !!,"Enter <RET> if this list is complete, or NO to add or delete",!,"patients on the list.",!!,"Press <RET> to continue " R X:DTIME G LIST
|
---|
| 31 | I "Yy"[ECYN Q:$O(ECPT(0)) D NOBODY Q:ECOUT
|
---|
| 32 | ADD W !!,"Add or Delete Patients ? ADD// " R ECADD:DTIME I '$T!(ECADD="^") S ECOUT=1 Q
|
---|
| 33 | S ECADD=$E(ECADD) S:ECADD="" ECADD="A" I "AaDd"'[ECADD W !!,"Enter <RET> to make additions to the list, or ""D"" to delete a ",!,"patient from the list." G ADD
|
---|
| 34 | I "Aa"[ECADD Q
|
---|
| 35 | DEL ; delete patients from list
|
---|
| 36 | I '$D(ECPT(1)) D NOBODY Q:ECOUT G LIST
|
---|
| 37 | W !!,"Select Number: " R X:DTIME I '$T!(X="^") S ECOUT=1 Q
|
---|
| 38 | I X="" Q
|
---|
| 39 | I '$D(ECPT(X)) W !!,"Select the number corresponding to the patient that you would like",!,"to remove from the list.",!!,"Press <RET> to continue " R X:DTIME S ECMORE=1 D LIST Q:ECOUT G DEL
|
---|
| 40 | F I=X+1:1:CNT S ECPT(I-1)=ECPT(I)
|
---|
| 41 | K ECPT(CNT),I S CNT=CNT-1
|
---|
| 42 | W !!,"Patient deleted.",!!,"Press <RET> to continue " R X:DTIME
|
---|
| 43 | G LIST
|
---|
| 44 | Q
|
---|
| 45 | HDR ;
|
---|
| 46 | W @IOF,!,"Location: "_ECLN
|
---|
| 47 | W !,"DSS Unit: "_ECDN
|
---|
| 48 | W !,"Ordering Section: ",ECON
|
---|
| 49 | W !,"Procedure Date: ",ECDATE,!
|
---|
| 50 | D DSP1416^ECPRVMUT(.ECPRVARY)
|
---|
| 51 | W !
|
---|
| 52 | Q
|
---|
| 53 | ;
|
---|
| 54 | NOBODY ;No patients selected
|
---|
| 55 | I $D(ECADD),ECADD="D" W !!,"You cannot delete patients when your patient list is empty."
|
---|
| 56 | I $G(ECADD)'="D" W !!,"You have selected no patients."
|
---|
| 57 | R !!,"Do you wish to quit? Y//",X:DTIME S X=$E(X) I '$T!(X="^") S ECOUT=1 Q
|
---|
| 58 | S:X="" X="Y" I "yY"[X S ECOUT=1 Q
|
---|
| 59 | I "nN"'[X W !,"Answer N to continue selection, or enter return to quit",! G NOBODY
|
---|
| 60 | Q
|
---|
| 61 | ;
|
---|
| 62 | ADCAT ;add category/procedures for patients
|
---|
| 63 | D ^ECBEN2A I ECOUT=1 Q
|
---|
| 64 | Q
|
---|
| 65 | KILL ;kill arrays
|
---|
| 66 | K ECA,ECHOICE,ECJLP,ECPT,ECC,ECCN,ECP,ECPN,ECV,NATN,NODE,SYN,SYS,VOL
|
---|
| 67 | K ^TMP("ECPRO",$J),ECDX,ECDXN,ECINP,ECVST,ECSC,ECAO,ECIR,ECZEC,EC4,EC4N
|
---|
| 68 | K ECID,ECMST,ECDXS,ECDXIEN,ECHNC,ECCV
|
---|
| 69 | S ECOUT=0
|
---|
| 70 | Q
|
---|
| 71 | DIAG ;ask dx, etc. questions
|
---|
| 72 | S (ECDX,ECDXN,ECINP,ECVST,ECSC,ECAO,ECIR,ECZEC,ECMST,ECHNC,ECCV)=""
|
---|
| 73 | S ECDFN=$P(ECPT(CNT),U)
|
---|
| 74 | ;- Determine inpatient/outpatient status
|
---|
| 75 | S ECPTSTAT=$$INOUTPT^ECUTL0(+$G(ECPT(CNT)),+$G(ECDT))
|
---|
| 76 | I ECPTSTAT="" D INOUTERR^ECUTL0 Q
|
---|
| 77 | ;- Determine patient eligibility
|
---|
| 78 | I $$CHKDSS^ECUTL0(+$G(ECD),ECPTSTAT) D
|
---|
| 79 | . I $$MULTELG^ECUTL0(+$G(ECPT(CNT))) S ECELIG=+$$ELGLST^ECUTL0
|
---|
| 80 | . E S ECELIG=+$G(VAEL(1))
|
---|
| 81 | K VAEL
|
---|
| 82 | D DSPSTAT^ECUTL0(ECPTSTAT)
|
---|
| 83 | I '$D(EC4) S EC4="",EC4N="NO ASSOCIATED CLINIC"
|
---|
| 84 | I '$D(ECID) S ECID=""
|
---|
| 85 | I $P(ECPCE,"~",2)="N" G SETDX
|
---|
| 86 | D PCEQST^ECBEN2U
|
---|
| 87 | I ECOUT D DELPT(.CNT) Q
|
---|
| 88 | SETDX ;set dx, etc. in pat array
|
---|
| 89 | S EC4N=$S($P($G(^SC(+EC4,0)),"^")]"":$P(^(0),"^"),1:"NO ASSOCIATED CLINIC"),ECID=$P($G(^SC(+EC4,0)),"^",7)
|
---|
| 90 | S ECPT(CNT)=ECPT(CNT)_"^"_ECDX_"^"_$S(ECINP="":$G(ECPTSTAT),1:ECINP)_"^"_ECVST_"^"_ECSC_"^"_ECAO_"^"_ECIR_"^"_ECZEC_"^"_EC4_"^"_ECID_"^"_ECMST_"^"_ECHNC_"^"_ECCV
|
---|
| 91 | I $D(ECDXS) M ECPT(CNT,"DXS")=ECDXS K ECDXS
|
---|
| 92 | Q
|
---|
| 93 | ;
|
---|
| 94 | DELPT(CNT) ;deselect patient due to missing required data
|
---|
| 95 | N DIR,Y
|
---|
| 96 | K ECPT(CNT) S CNT=CNT-1
|
---|
| 97 | W !,"Required data missing.",!,"Patient deselected...",!
|
---|
| 98 | S ECOUT=0
|
---|
| 99 | S DIR(0)="E",DIR("A")="Press RETURN to continue"
|
---|
| 100 | D ^DIR
|
---|
| 101 | W !
|
---|
| 102 | Q
|
---|