ECBEN1B.m

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 ---ECBEN1B   4386     printed  Feb 18, 2025@23:23:14                                                                                                                                                                                                     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