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
Q
;
;
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
Q
;
;
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
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECRUTL 5813 printed Apr 09, 2024@21:00:40 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
