ECBEN1B ;BIR/MAM,JPW-Batch Enter Procedures (cont'd) ;1 May 96
;;2.0; EVENT CAPTURE ;**4,5,10,13,17,23,41,42,50,54,72,76**;8 May 96;Build 6
EN ;entry pt
D HDR
S CNT=0
PATS ; get patients
W ! Q:ECOUT=1 K ECADD
K DIC,DUOUT S DIC=2,DIC(0)="QEAMZ",DIC("A")=$S($D(ECPT):"Select Next Patient: ",1:"Select Patient: ")
D ^DIC K DIC S OK=0
I $D(DUOUT)!($D(DTOUT)) S ECOUT=1 Q
I Y<0,CNT=0 S ECOUT=2 Q
I Y<0 D G PATS
.D LIST Q:ECOUT=1 Q:'$O(ECPT(0)) Q:$G(ECADD)="A"
.S ECTWO=0 K ECHOICE D ^ECBEN2A
.I ECOUT=2 D KILL,HDR
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.",!
I OK=1 G PATS
N YY,ECUP D I $G(ECUP)="^" G PATS
. S YY=Y,DFN=+Y D 2^VADPT S Y=YY I +VADM(6) D
. . ; NOIS MWV-0603-21781:line below changed by VMP.
. . W !!,"WARNING "_"[PATIENT DIED ON "_$P(VADM(6),U,2)_"] ",!!
. . R "Press Return to Continue or ^ to Deselect: ",ECUP:DTIME
S CNT=CNT+1,CNT1=CNT,ECPT(CNT)=+Y_"^"_$P(Y,"^",2) D DIAG
G PATS
;
LIST ; list patients
K ECADD
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)
W !!,"Is this list correct ? YES// " R ECYN:DTIME I '$T!(ECYN="^") S ECOUT=1 Q
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
I "Yy"[ECYN Q:$O(ECPT(0)) D NOBODY Q:ECOUT
ADD W !!,"Add or Delete Patients ? ADD// " R ECADD:DTIME I '$T!(ECADD="^") S ECOUT=1 Q
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
I "Aa"[ECADD Q
DEL ; delete patients from list
I '$D(ECPT(1)) D NOBODY Q:ECOUT G LIST
W !!,"Select Number: " R X:DTIME I '$T!(X="^") S ECOUT=1 Q
I X="" Q
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
F I=X+1:1:CNT S ECPT(I-1)=ECPT(I)
K ECPT(CNT),I S CNT=CNT-1
W !!,"Patient deleted.",!!,"Press <RET> to continue " R X:DTIME
G LIST
Q
HDR ;
W @IOF,!,"Location: "_ECLN
W !,"DSS Unit: "_ECDN
W !,"Ordering Section: ",ECON
W !,"Procedure Date: ",ECDATE,!
D DSP1416^ECPRVMUT(.ECPRVARY)
W !
Q
;
NOBODY ;No patients selected
I $D(ECADD),ECADD="D" W !!,"You cannot delete patients when your patient list is empty."
I $G(ECADD)'="D" W !!,"You have selected no patients."
R !!,"Do you wish to quit? Y//",X:DTIME S X=$E(X) I '$T!(X="^") S ECOUT=1 Q
S:X="" X="Y" I "yY"[X S ECOUT=1 Q
I "nN"'[X W !,"Answer N to continue selection, or enter return to quit",! G NOBODY
Q
;
ADCAT ;add category/procedures for patients
D ^ECBEN2A I ECOUT=1 Q
Q
KILL ;kill arrays
K ECA,ECHOICE,ECJLP,ECPT,ECC,ECCN,ECP,ECPN,ECV,NATN,NODE,SYN,SYS,VOL
K ^TMP("ECPRO",$J),ECDX,ECDXN,ECINP,ECVST,ECSC,ECAO,ECIR,ECZEC,EC4,EC4N
K ECID,ECMST,ECDXS,ECDXIEN,ECHNC,ECCV,ECSHAD
S ECOUT=0
Q
DIAG ;ask dx, etc. questions
S (ECDX,ECDXN,ECINP,ECVST,ECSC,ECAO,ECIR,ECZEC,ECMST,ECHNC,ECCV)=""
S ECDFN=$P(ECPT(CNT),U),ECSHAD=""
;- Determine inpatient/outpatient status
S ECPTSTAT=$$INOUTPT^ECUTL0(+$G(ECPT(CNT)),+$G(ECDT))
I ECPTSTAT="" D INOUTERR^ECUTL0 Q
;- Determine patient eligibility
I $$CHKDSS^ECUTL0(+$G(ECD),ECPTSTAT) D
. I $$MULTELG^ECUTL0(+$G(ECPT(CNT))) S ECELIG=+$$ELGLST^ECUTL0
. E S ECELIG=+$G(VAEL(1))
K VAEL
D DSPSTAT^ECUTL0(ECPTSTAT)
I '$D(EC4) S EC4="",EC4N="NO ASSOCIATED CLINIC"
I '$D(ECID) S ECID=""
I $P(ECPCE,"~",2)="N" G SETDX
D PCEQST^ECBEN2U
I ECOUT D DELPT(.CNT) Q
SETDX ;set dx, etc. in pat array
S EC4N=$S($P($G(^SC(+EC4,0)),"^")]"":$P(^(0),"^"),1:"NO ASSOCIATED CLINIC"),ECID=$P($G(^SC(+EC4,0)),"^",7)
S ECPT(CNT)=ECPT(CNT)_"^"_ECDX_"^"_$S(ECINP="":$G(ECPTSTAT),1:ECINP)_"^"_ECVST_"^"_ECSC_"^"_ECAO_"^"_ECIR_"^"_ECZEC_"^"_EC4_"^"_ECID_"^"_ECMST_"^"_ECHNC_"^"_ECCV_"^"_ECSHAD
I $D(ECDXS) M ECPT(CNT,"DXS")=ECDXS K ECDXS
Q
;
DELPT(CNT) ;deselect patient due to missing required data
N DIR,Y
K ECPT(CNT) S CNT=CNT-1
W !,"Required data missing.",!,"Patient deselected...",!
S ECOUT=0
S DIR(0)="E",DIR("A")="Press RETURN to continue"
D ^DIR
W !
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECBEN1B 4386 printed Nov 22, 2024@17:06:59 Page 2
ECBEN1B ;BIR/MAM,JPW-Batch Enter Procedures (cont'd) ;1 May 96
+1 ;;2.0; EVENT CAPTURE ;**4,5,10,13,17,23,41,42,50,54,72,76**;8 May 96;Build 6
EN ;entry pt
+1 DO HDR
+2 SET CNT=0
PATS ; get patients
+1 WRITE !
if ECOUT=1
QUIT
KILL ECADD
+2 KILL DIC,DUOUT
SET DIC=2
SET DIC(0)="QEAMZ"
SET DIC("A")=$SELECT($DATA(ECPT):"Select Next Patient: ",1:"Select Patient: ")
+3 DO ^DIC
KILL DIC
SET OK=0
+4 IF $DATA(DUOUT)!($DATA(DTOUT))
SET ECOUT=1
QUIT
+5 IF Y<0
IF CNT=0
SET ECOUT=2
QUIT
+6 IF Y<0
Begin DoDot:1
+7 DO LIST
if ECOUT=1
QUIT
if '$ORDER(ECPT(0))
QUIT
if $GET(ECADD)="A"
QUIT
+8 SET ECTWO=0
KILL ECHOICE
DO ^ECBEN2A
+9 IF ECOUT=2
DO KILL
DO HDR
End DoDot:1
GOTO PATS
+10 IF $ORDER(ECPT(0))
SET JJ=""
FOR
SET JJ=$ORDER(ECPT(JJ))
if 'JJ!(OK=1)
QUIT
IF +$GET(ECPT(JJ))=+Y
SET OK=1
WRITE !!,"Patient already selected. Please select another patient.",!
+11 IF OK=1
GOTO PATS
+12 NEW YY,ECUP
Begin DoDot:1
+13 SET YY=Y
SET DFN=+Y
DO 2^VADPT
SET Y=YY
IF +VADM(6)
Begin DoDot:2
+14 ; NOIS MWV-0603-21781:line below changed by VMP.
+15 WRITE !!,"WARNING "_"[PATIENT DIED ON "_$PIECE(VADM(6),U,2)_"] ",!!
+16 READ "Press Return to Continue or ^ to Deselect: ",ECUP:DTIME
End DoDot:2
End DoDot:1
IF $GET(ECUP)="^"
GOTO PATS
+17 SET CNT=CNT+1
SET CNT1=CNT
SET ECPT(CNT)=+Y_"^"_$PIECE(Y,"^",2)
DO DIAG
+18 GOTO PATS
+19 ;
LIST ; list patients
+1 KILL ECADD
+2 WRITE @IOF,!,"Patients Selected for Batch Entry: ",!
FOR I=0:0
SET I=$ORDER(ECPT(I))
if 'I
QUIT
if I#2
WRITE !
if I#2=0
WRITE ?40
WRITE I_". "_$PIECE(ECPT(I),"^",2)
+3 WRITE !!,"Is this list correct ? YES// "
READ ECYN:DTIME
IF '$TEST!(ECYN="^")
SET ECOUT=1
QUIT
+4 SET ECYN=$EXTRACT(ECYN)
if ECYN=""
SET ECYN="Y"
IF "YyNn"'[ECYN
WRITE !!,"Enter <RET> if this list is complete, or NO to add or delete",!,"patients on the list.",!!,"Press <RET> to continue "
READ X:DTIME
GOTO LIST
+5 IF "Yy"[ECYN
if $ORDER(ECPT(0))
QUIT
DO NOBODY
if ECOUT
QUIT
ADD WRITE !!,"Add or Delete Patients ? ADD// "
READ ECADD:DTIME
IF '$TEST!(ECADD="^")
SET ECOUT=1
QUIT
+1 SET ECADD=$EXTRACT(ECADD)
if ECADD=""
SET ECADD="A"
IF "AaDd"'[ECADD
WRITE !!,"Enter <RET> to make additions to the list, or ""D"" to delete a ",!,"patient from the list."
GOTO ADD
+2 IF "Aa"[ECADD
QUIT
DEL ; delete patients from list
+1 IF '$DATA(ECPT(1))
DO NOBODY
if ECOUT
QUIT
GOTO LIST
+2 WRITE !!,"Select Number: "
READ X:DTIME
IF '$TEST!(X="^")
SET ECOUT=1
QUIT
+3 IF X=""
QUIT
+4 IF '$DATA(ECPT(X))
WRITE !!,"Select the number corresponding to the patient that you would like",!,"to remove from the list.",!!,"Press <RET> to continue "
READ X:DTIME
SET ECMORE=1
DO LIST
if ECOUT
QUIT
GOTO DEL
+5 FOR I=X+1:1:CNT
SET ECPT(I-1)=ECPT(I)
+6 KILL ECPT(CNT),I
SET CNT=CNT-1
+7 WRITE !!,"Patient deleted.",!!,"Press <RET> to continue "
READ X:DTIME
+8 GOTO LIST
+9 QUIT
HDR ;
+1 WRITE @IOF,!,"Location: "_ECLN
+2 WRITE !,"DSS Unit: "_ECDN
+3 WRITE !,"Ordering Section: ",ECON
+4 WRITE !,"Procedure Date: ",ECDATE,!
+5 DO DSP1416^ECPRVMUT(.ECPRVARY)
+6 WRITE !
+7 QUIT
+8 ;
NOBODY ;No patients selected
+1 IF $DATA(ECADD)
IF ECADD="D"
WRITE !!,"You cannot delete patients when your patient list is empty."
+2 IF $GET(ECADD)'="D"
WRITE !!,"You have selected no patients."
+3 READ !!,"Do you wish to quit? Y//",X:DTIME
SET X=$EXTRACT(X)
IF '$TEST!(X="^")
SET ECOUT=1
QUIT
+4 if X=""
SET X="Y"
IF "yY"[X
SET ECOUT=1
QUIT
+5 IF "nN"'[X
WRITE !,"Answer N to continue selection, or enter return to quit",!
GOTO NOBODY
+6 QUIT
+7 ;
ADCAT ;add category/procedures for patients
+1 DO ^ECBEN2A
IF ECOUT=1
QUIT
+2 QUIT
KILL ;kill arrays
+1 KILL ECA,ECHOICE,ECJLP,ECPT,ECC,ECCN,ECP,ECPN,ECV,NATN,NODE,SYN,SYS,VOL
+2 KILL ^TMP("ECPRO",$JOB),ECDX,ECDXN,ECINP,ECVST,ECSC,ECAO,ECIR,ECZEC,EC4,EC4N
+3 KILL ECID,ECMST,ECDXS,ECDXIEN,ECHNC,ECCV,ECSHAD
+4 SET ECOUT=0
+5 QUIT
DIAG ;ask dx, etc. questions
+1 SET (ECDX,ECDXN,ECINP,ECVST,ECSC,ECAO,ECIR,ECZEC,ECMST,ECHNC,ECCV)=""
+2 SET ECDFN=$PIECE(ECPT(CNT),U)
SET ECSHAD=""
+3 ;- Determine inpatient/outpatient status
+4 SET ECPTSTAT=$$INOUTPT^ECUTL0(+$GET(ECPT(CNT)),+$GET(ECDT))
+5 IF ECPTSTAT=""
DO INOUTERR^ECUTL0
QUIT
+6 ;- Determine patient eligibility
+7 IF $$CHKDSS^ECUTL0(+$GET(ECD),ECPTSTAT)
Begin DoDot:1
+8 IF $$MULTELG^ECUTL0(+$GET(ECPT(CNT)))
SET ECELIG=+$$ELGLST^ECUTL0
+9 IF '$TEST
SET ECELIG=+$GET(VAEL(1))
End DoDot:1
+10 KILL VAEL
+11 DO DSPSTAT^ECUTL0(ECPTSTAT)
+12 IF '$DATA(EC4)
SET EC4=""
SET EC4N="NO ASSOCIATED CLINIC"
+13 IF '$DATA(ECID)
SET ECID=""
+14 IF $PIECE(ECPCE,"~",2)="N"
GOTO SETDX
+15 DO PCEQST^ECBEN2U
+16 IF ECOUT
DO DELPT(.CNT)
QUIT
SETDX ;set dx, etc. in pat array
+1 SET EC4N=$SELECT($PIECE($GET(^SC(+EC4,0)),"^")]"":$PIECE(^(0),"^"),1:"NO ASSOCIATED CLINIC")
SET ECID=$PIECE($GET(^SC(+EC4,0)),"^",7)
+2 SET ECPT(CNT)=ECPT(CNT)_"^"_ECDX_"^"_$SELECT(ECINP="":$GET(ECPTSTAT),1:ECINP)_"^"_ECVST_"^"_ECSC_"^"_ECAO_"^"_ECIR_"^"_ECZEC_"^"_EC4_"^"_ECID_"^"_ECMST_"^"_ECHNC_"^"_ECCV_"^"_ECSHAD
+3 IF $DATA(ECDXS)
MERGE ECPT(CNT,"DXS")=ECDXS
KILL ECDXS
+4 QUIT
+5 ;
DELPT(CNT) ;deselect patient due to missing required data
+1 NEW DIR,Y
+2 KILL ECPT(CNT)
SET CNT=CNT-1
+3 WRITE !,"Required data missing.",!,"Patient deselected...",!
+4 SET ECOUT=0
+5 SET DIR(0)="E"
SET DIR("A")="Press RETURN to continue"
+6 DO ^DIR
+7 WRITE !
+8 QUIT
