Routine: ECRUTL

ECRUTL ;ALB/ESD - Event Capture Report Utilities ;1 Aug 97

 ;;2.0; EVENT CAPTURE ;**5,100**;8 May 96;Build 21

ASKLOC() ; Ask report location(s) (institution)

 ;   Input:  None

 ;  Output:  1 if successful - location(s) will be in array ECLOC

 ;           0 if unsuccessful

 N DIRUT,DUOUT,ECN,ECNUM,ECX,Y

 D LOCARRY

 ;- Only one location exists

 I '$D(ECLOC(2)) G ASKLOCQ

W !

 S DIR(0)="YA",DIR("A")="Do you want to print this report for all locations? ",DIR("B")="YES",DIR("?")="Enter YES to choose all Event Capture locations or NO to select a specific location."

 D ^DIR K DIR I $D(DIRUT) K ECLOC G ASKLOCQ

 I +Y G ASKLOCQ

 I 'Y D

 . W @IOF,!,"Event Capture Locations:",!

 . F ECX=0:0 S ECX=$O(ECLOC(ECX)) Q:'ECX  W ECX_".  ",$P(ECLOC(ECX),"^",2),!

 . S ECNUM=$$SEL

 . I ECNUM D

 .. S ECLOC(1)=+$P(ECLOC(ECNUM),"^")_"^"_$P(ECLOC(ECNUM),"^",2)

 .. F ECX=0:0 S ECX=$O(ECLOC(ECX)) Q:'ECX  K:(ECX>1) ECLOC(ECX)

 . I 'ECNUM K ECLOC

ASKLOCQ Q $S('$D(ECLOC):0,1:1)

LOCARRY ;-- Get location(s) from "LOC" xref of DMMS Units (#720) fld of

 ;   INSTITUTION file and create ECLOC array

 N ECLNAM,ECLNUM,ECCNT

 S (ECCNT,ECLNUM)=0,ECLNAM=""

 F  S ECLNAM=$O(^DIC(4,"LOC",ECLNAM)) Q:ECLNAM=""  F  S ECLNUM=$O(^DIC(4,"LOC",ECLNAM,ECLNUM)) Q:'ECLNUM  S ECCNT=ECCNT+1,ECLOC(ECCNT)=ECLNUM_"^"_ECLNAM,ECLOC1(ECLNUM)=ECLNAM

SEL() ;-- Select one location from ECLOC array

GETNUM N DIRUT,DUOUT,Y

 S DIR(0)="NA",DIR("A")="Select Number: ",DIR("?")=$P($T(HLPTXT),";;",2)

 D ^DIR K DIR

 I $D(DIRUT) S ECN=0 G SELQ

 I '$D(ECLOC(+Y)) W !!,$P($T(HLPTXT),";;",2) G GETNUM

 S ECN=+Y

SELQ Q +$G(ECN)

ASKDSS() ; Ask DSS Unit(s)

 ;   Input:  None

 ;  Output:  1 if successful - DSS Units will be in array ECDSSU

 ;           0 if unsuccessful

 N DIRUT,DUOUT,ECKEY,ECNT,ECD,ECN,ECX,I,Y

 S ECKEY=$S($D(^XUSEC("ECALLU",DUZ)):1,1:0)

 W ! S DIR(0)="YA"

 S DIR("A")="Do you want to print this report for all "_$S('ECKEY:"accessible ",1:"")_"DSS Units? ",DIR("B")="YES"

 D ^DIR K DIR

 G:$D(DIRUT) ASKDSSQ

 D @($S(+Y:"ALLU",1:"SPECU"))

ASKDSSQ Q $S('$D(ECDSSU):0,1:1)

ALLU ;-- Get all DSS Units and create ECDSSU array

 N DIR,ECD,ECN,ECX,I,Y

 S ECD="",(ECN,ECX)=0

 F  S ECD=$O(^ECD("B",ECD)) Q:ECD=""  F  S ECN=$O(^ECD("B",ECD,ECN)) Q:'ECN  D

 . Q:'$$VALID(ECN)!('ECKEY&('$D(^VA(200,DUZ,"EC",+ECN))))

 . S ECX=ECX+1,ECDSSU(ECX)=ECN_"^"_ECD

 I '$D(ECDSSU) D

 . W !!,$P($T(NOUNITS),";;",2),!

 . F I=0:1:1 W !,$P($T(ERRMSG+I),";;",2)

 . W ! S DIR(0)="E" D ^DIR

ALLUQ Q

SPECU ;-- Get specific DSS Units

 N DIRUT,DUOUT,Y

W !

 S DIR(0)="YA",DIR("A")="Do you want to print this report for specific DSS Unit(s)? ",DIR("B")="YES"

 S DIR("?")="Enter YES to select specific DSS Unit(s) or NO to quit."

 D ^DIR K DIR

 I 'Y!($D(DIRUT)) G SPECUQ

 D SELU

SPECUQ Q

SELU ;-- Create ECDSSU array containing DSS Units after checking for validity and access to Unit

 N ECX,I,Y,Z

 S (ECX,Z)=0

GETU W ! K DUOUT,DTOUT,DIRUT,Y

 S DIC=724,DIC("A")="Select DSS Unit: ",DIC(0)="QEAMZ"

 S DIC("S")="I ECKEY!($D(^VA(200,DUZ,""EC"",+Y)))"

 D ^DIC K DIC

 G SELUQ:$D(DTOUT)!($D(DUOUT))

 I +Y>0 D  G GETU

 . F I=1:1:ECX I +Y=+ECDSSU(I) D  Q

 .. W !,?10,"But you already selected that one... try again."

 .. S Y=-1

 . Q:Y=-1

 . I $$VALID(+Y) S ECX=ECX+1,ECDSSU(ECX)=Y

 . I '$$VALID(+Y) W ! F I=0:1:1 W !?5,$P($T(INVALID+I),";;",2)

 I +Y<0 S Z=$$DISPU() I 'Z W !!?10," *** NO DSS UNITS SELECTED ***" G SELUQ

 W ! S DIR(0)="YA",DIR("A")="Is this list correct? ",DIR("B")="YES",DIR("?")="Answer YES to accept the list, NO to start over."

 D ^DIR K DIR

 I $D(DIRUT) G SELUQ

 I '$G(Y) S ECX=0 K ECDSSU G GETU

SELUQ I $D(DIRUT)!($D(DTOUT))!($D(DUOUT)) D

 . I $D(ECDSSU) W !!,?10,"Deleting selection...",!

 . K ECDSSU

VALID(IEN) ;-- Check DSS Unit for use by Event Capture

 N NODE

 S NODE=$G(^ECD(IEN,0))

 Q $S($P(NODE,"^",8):1,1:0)

DISPU(TYP) ;-- Display DSS Units

N X

 I '$D(ECDSSU) G DISPUQ

 W @IOF,!!,$S($G(TYP)="All":TYP,1:"Selected")_" DSS Units:",!

 F X=0:0 S X=$O(ECDSSU(X)) Q:'X  W !?5,X_". ",$P(ECDSSU(X),"^",2)

W !

DISPUQ Q $S($D(ECDSSU):1,1:0)

HLPTXT ;;  Enter the number corresponding to the location you want to select.

NOUNITS ;;  You do not have access to any DSS Units.

ERRMSG ;;  If you are responsible for printing this report, contact your Event

 ;;  Capture ADPAC to allow access.

INVALID ;;  This DSS Unit is either inactive or cannot be used with the

 ;;  Event Capture software.  Please select another DSS Unit.

STDT() ; Get Start Date

 ;   Input:  None

 ;  Output:  1 if successful - start date in ECSTDT

 ;           0 if unsuccessful

EN N DIRUT,DUOUT,Y

 W ! S DIR(0)="DA^::EX",DIR("A")="Enter Start Date: ",DIR("?")="^D HELP^%DTC"

 D ^DIR K DIR G:$D(DIRUT) STDTQ

 I (+Y>DT) W !,"*** Future dates are not allowed ***" G EN

 S ECSTDT=+Y,ECSTDT=ECSTDT-.0001

STDTQ Q $S($G(ECSTDT):1,1:0)

ENDDT(STDT) ; Get End Date

 ;   Input:  STDT - Start Date

 ;  Output:  1 if successful - end date in ECENDDT

 ;           0 if unsuccessful

 N DIRUT,DUOUT,Y

 G:'$G(STDT) ENDDTQ

 W ! S DIR(0)="DA^"_STDT_":DT:EX",DIR("A")="Enter End Date: "

 S DIR("?")="^W ""*** Future dates are not allowed ***"",! D HELP^%DTC"

 D ^DIR K DIR G:$D(DIRUT) ENDDTQ

 S ECENDDT=+Y,ECENDDT=ECENDDT+.9999

ENDDTQ Q $S($G(ECENDDT):1,1:0)

REASON ;* Prompt to report Procedure Reasons

 ;* Variables returned

 ;   ECRY - Must be KILLed by calling routine

 S DIR(0)="Y^A"

 S DIR("A")="Do you want to include Procedure Reasons"

 S DIR("B")="NO"

 S DIR("?",1)="Enter Yes to include procedure reasons on the report."

 S DIR("?")="Enter No to report without procedure reasons."

 D ^DIR

 S:(+Y=1) ECRY=""

 K DIR,Y

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECRUTL   5813     printed  Feb 18, 2025@23:25:11                                                                                                                                                                                                      Page 2

ECRUTL    ;ALB/ESD - Event Capture Report Utilities ;1 Aug 97

 +1       ;;2.0; EVENT CAPTURE ;**5,100**;8 May 96;Build 21

 +2       ;

ASKLOC()  ; Ask report location(s) (institution)

 +1       ;   Input:  None

 +2       ;  Output:  1 if successful - location(s) will be in array ECLOC

 +3       ;           0 if unsuccessful

 +4       ;

 +5        NEW DIRUT,DUOUT,ECN,ECNUM,ECX,Y

 +6        DO LOCARRY

 +7       ;

 +8       ;- Only one location exists

 +9        IF '$DATA(ECLOC(2))

               GOTO ASKLOCQ

 +10      ;

 +11       WRITE !

 +12       SET DIR(0)="YA"

           SET DIR("A")="Do you want to print this report for all locations? "

           SET DIR("B")="YES"

           SET DIR("?")="Enter YES to choose all Event Capture locations or NO to select a specific location."

 +13       DO ^DIR

           KILL DIR

           IF $DATA(DIRUT)

               KILL ECLOC

               GOTO ASKLOCQ

 +14       IF +Y

               GOTO ASKLOCQ

 +15       IF 'Y

               Begin DoDot:1

 +16               WRITE @IOF,!,"Event Capture Locations:",!

 +17               FOR ECX=0:0

                       SET ECX=$ORDER(ECLOC(ECX))

                       if 'ECX

                           QUIT

                       WRITE ECX_".  ",$PIECE(ECLOC(ECX),"^",2),!

 +18               SET ECNUM=$$SEL

 +19               IF ECNUM

                       Begin DoDot:2

 +20                       SET ECLOC(1)=+$PIECE(ECLOC(ECNUM),"^")_"^"_$PIECE(ECLOC(ECNUM),"^",2)

 +21                       FOR ECX=0:0

                               SET ECX=$ORDER(ECLOC(ECX))

                               if 'ECX

                                   QUIT

                               if (ECX>1)

                                   KILL ECLOC(ECX)

                       End DoDot:2

 +22               IF 'ECNUM

                       KILL ECLOC

               End DoDot:1

ASKLOCQ    QUIT $SELECT('$DATA(ECLOC):0,1:1)

 +1       ;

 +2       ;

LOCARRY   ;-- Get location(s) from "LOC" xref of DMMS Units (#720) fld of

 +1       ;   INSTITUTION file and create ECLOC array

 +2       ;

 +3        NEW ECLNAM,ECLNUM,ECCNT

 +4        SET (ECCNT,ECLNUM)=0

           SET ECLNAM=""

 +5        FOR

               SET ECLNAM=$ORDER(^DIC(4,"LOC",ECLNAM))

               if ECLNAM=""

                   QUIT

FOR

                   SET ECLNUM=$ORDER(^DIC(4,"LOC",ECLNAM,ECLNUM))

                   if 'ECLNUM

                       QUIT

                   SET ECCNT=ECCNT+1

                   SET ECLOC(ECCNT)=ECLNUM_"^"_ECLNAM

                   SET ECLOC1(ECLNUM)=ECLNAM

 +6        QUIT

 +7       ;

 +8       ;

SEL()     ;-- Select one location from ECLOC array

 +1       ;

GETNUM     NEW DIRUT,DUOUT,Y

 +1        SET DIR(0)="NA"

           SET DIR("A")="Select Number: "

           SET DIR("?")=$PIECE($TEXT(HLPTXT),";;",2)

 +2        DO ^DIR

           KILL DIR

 +3        IF $DATA(DIRUT)

               SET ECN=0

               GOTO SELQ

 +4        IF '$DATA(ECLOC(+Y))

               WRITE !!,$PIECE($TEXT(HLPTXT),";;",2)

               GOTO GETNUM

 +5        SET ECN=+Y

SELQ       QUIT +$GET(ECN)

 +1       ;

 +2       ;

 +3       ;

ASKDSS()  ; Ask DSS Unit(s)

 +1       ;   Input:  None

 +2       ;  Output:  1 if successful - DSS Units will be in array ECDSSU

 +3       ;           0 if unsuccessful

 +4       ;

 +5        NEW DIRUT,DUOUT,ECKEY,ECNT,ECD,ECN,ECX,I,Y

 +6        SET ECKEY=$SELECT($DATA(^XUSEC("ECALLU",DUZ)):1,1:0)

 +7        WRITE !

           SET DIR(0)="YA"

 +8        SET DIR("A")="Do you want to print this report for all "_$SELECT('ECKEY:"accessible ",1:"")_"DSS Units? "

           SET DIR("B")="YES"

 +9        DO ^DIR

           KILL DIR

 +10       if $DATA(DIRUT)

               GOTO ASKDSSQ

 +11       DO @($SELECT(+Y:"ALLU",1:"SPECU"))

ASKDSSQ    QUIT $SELECT('$DATA(ECDSSU):0,1:1)

 +1       ;

 +2       ;

ALLU      ;-- Get all DSS Units and create ECDSSU array

 +1        NEW DIR,ECD,ECN,ECX,I,Y

 +2        SET ECD=""

           SET (ECN,ECX)=0

 +3        FOR

               SET ECD=$ORDER(^ECD("B",ECD))

               if ECD=""

                   QUIT

FOR

                   SET ECN=$ORDER(^ECD("B",ECD,ECN))

                   if 'ECN

                       QUIT

                   Begin DoDot:1

 +4                    if '$$VALID(ECN)!('ECKEY&('$DATA(^VA(200,DUZ,"EC",+ECN))))

                           QUIT

 +5                    SET ECX=ECX+1

                       SET ECDSSU(ECX)=ECN_"^"_ECD

                   End DoDot:1

 +6        IF '$DATA(ECDSSU)

               Begin DoDot:1

 +7                WRITE !!,$PIECE($TEXT(NOUNITS),";;",2),!

 +8                FOR I=0:1:1

                       WRITE !,$PIECE($TEXT(ERRMSG+I),";;",2)

 +9                WRITE !

                   SET DIR(0)="E"

                   DO ^DIR

               End DoDot:1

ALLUQ      QUIT

 +1       ;

 +2       ;

SPECU     ;-- Get specific DSS Units

 +1        NEW DIRUT,DUOUT,Y

 +2        WRITE !

 +3        SET DIR(0)="YA"

           SET DIR("A")="Do you want to print this report for specific DSS Unit(s)? "

           SET DIR("B")="YES"

 +4        SET DIR("?")="Enter YES to select specific DSS Unit(s) or NO to quit."

 +5        DO ^DIR

           KILL DIR

 +6        IF 'Y!($DATA(DIRUT))

               GOTO SPECUQ

 +7        DO SELU

SPECUQ     QUIT

 +1       ;

 +2       ;

SELU      ;-- Create ECDSSU array containing DSS Units after checking for validity and access to Unit

 +1        NEW ECX,I,Y,Z

 +2        SET (ECX,Z)=0

GETU       WRITE !

           KILL DUOUT,DTOUT,DIRUT,Y

 +1        SET DIC=724

           SET DIC("A")="Select DSS Unit: "

           SET DIC(0)="QEAMZ"

 +2        SET DIC("S")="I ECKEY!($D(^VA(200,DUZ,""EC"",+Y)))"

 +3        DO ^DIC

           KILL DIC

 +4        if $DATA(DTOUT)!($DATA(DUOUT))

               GOTO SELUQ

 +5        IF +Y>0

               Begin DoDot:1

 +6                FOR I=1:1:ECX

                       IF +Y=+ECDSSU(I)

                           Begin DoDot:2

 +7                            WRITE !,?10,"But you already selected that one... try again."

 +8                            SET Y=-1

                           End DoDot:2

                           QUIT

 +9                if Y=-1

                       QUIT

 +10               IF $$VALID(+Y)

                       SET ECX=ECX+1

                       SET ECDSSU(ECX)=Y

 +11               IF '$$VALID(+Y)

                       WRITE !

                       FOR I=0:1:1

                           WRITE !?5,$PIECE($TEXT(INVALID+I),";;",2)

               End DoDot:1

               GOTO GETU

 +12       IF +Y<0

               SET Z=$$DISPU()

               IF 'Z

                   WRITE !!?10," *** NO DSS UNITS SELECTED ***"

                   GOTO SELUQ

 +13       WRITE !

           SET DIR(0)="YA"

           SET DIR("A")="Is this list correct? "

           SET DIR("B")="YES"

           SET DIR("?")="Answer YES to accept the list, NO to start over."

 +14       DO ^DIR

           KILL DIR

 +15       IF $DATA(DIRUT)

               GOTO SELUQ

 +16       IF '$GET(Y)

               SET ECX=0

               KILL ECDSSU

               GOTO GETU

SELUQ      IF $DATA(DIRUT)!($DATA(DTOUT))!($DATA(DUOUT))

               Begin DoDot:1

 +1                IF $DATA(ECDSSU)

                       WRITE !!,?10,"Deleting selection...",!

 +2                KILL ECDSSU

               End DoDot:1

 +3        QUIT

 +4       ;

 +5       ;

VALID(IEN) ;-- Check DSS Unit for use by Event Capture

 +1        NEW NODE

 +2        SET NODE=$GET(^ECD(IEN,0))

 +3        QUIT $SELECT($PIECE(NODE,"^",8):1,1:0)

 +4       ;

 +5       ;

DISPU(TYP) ;-- Display DSS Units

 +1        NEW X

 +2        IF '$DATA(ECDSSU)

               GOTO DISPUQ

 +3        WRITE @IOF,!!,$SELECT($GET(TYP)="All":TYP,1:"Selected")_" DSS Units:",!

 +4        FOR X=0:0

               SET X=$ORDER(ECDSSU(X))

               if 'X

                   QUIT

               WRITE !?5,X_". ",$PIECE(ECDSSU(X),"^",2)

 +5        WRITE !

DISPUQ     QUIT $SELECT($DATA(ECDSSU):1,1:0)

 +1       ;

 +2       ;

HLPTXT    ;;  Enter the number corresponding to the location you want to select.

NOUNITS   ;;  You do not have access to any DSS Units.

ERRMSG    ;;  If you are responsible for printing this report, contact your Event

 +1       ;;  Capture ADPAC to allow access.

INVALID   ;;  This DSS Unit is either inactive or cannot be used with the

 +1       ;;  Event Capture software.  Please select another DSS Unit.

 +2       ;

 +3       ;

 +4       ;

STDT()    ; Get Start Date

 +1       ;   Input:  None

 +2       ;  Output:  1 if successful - start date in ECSTDT

 +3       ;           0 if unsuccessful

 +4       ;

EN         NEW DIRUT,DUOUT,Y

 +1        WRITE !

           SET DIR(0)="DA^::EX"

           SET DIR("A")="Enter Start Date: "

           SET DIR("?")="^D HELP^%DTC"

 +2        DO ^DIR

           KILL DIR

           if $DATA(DIRUT)

               GOTO STDTQ

 +3        IF (+Y>DT)

               WRITE !,"*** Future dates are not allowed ***"

               GOTO EN

 +4        SET ECSTDT=+Y

           SET ECSTDT=ECSTDT-.0001

STDTQ      QUIT $SELECT($GET(ECSTDT):1,1:0)

 +1       ;

 +2       ;

 +3       ;

ENDDT(STDT) ; Get End Date

 +1       ;   Input:  STDT - Start Date

 +2       ;  Output:  1 if successful - end date in ECENDDT

 +3       ;           0 if unsuccessful

 +4       ;

 +5        NEW DIRUT,DUOUT,Y

 +6        if '$GET(STDT)

               GOTO ENDDTQ

 +7        WRITE !

           SET DIR(0)="DA^"_STDT_":DT:EX"

           SET DIR("A")="Enter End Date: "

 +8        SET DIR("?")="^W ""*** Future dates are not allowed ***"",! D HELP^%DTC"

 +9        DO ^DIR

           KILL DIR

           if $DATA(DIRUT)

               GOTO ENDDTQ

 +10       SET ECENDDT=+Y

           SET ECENDDT=ECENDDT+.9999

ENDDTQ     QUIT $SELECT($GET(ECENDDT):1,1:0)

 +1       ;

REASON    ;* Prompt to report Procedure Reasons

 +1       ;

 +2       ;* Variables returned

 +3       ;   ECRY - Must be KILLed by calling routine

 +4       ;

 +5        SET DIR(0)="Y^A"

 +6        SET DIR("A")="Do you want to include Procedure Reasons"

 +7        SET DIR("B")="NO"

 +8        SET DIR("?",1)="Enter Yes to include procedure reasons on the report."

 +9        SET DIR("?")="Enter No to report without procedure reasons."

 +10       DO ^DIR

 +11       if (+Y=1)

               SET ECRY=""

 +12       KILL DIR,Y

 +13       QUIT

ECRUTL.m