ECRDSSA ;ALB/RPM - DSS Unit Activity Report ;9/23/16 15:14
;;2.0;EVENT CAPTURE;**95,104,112,119,126,131,134**;8 May 96;Build 12
;
EN ;Get location(s), DSS Unit(s), sort type, start & end dates, device
;
N ECLOC,ECDSSU,ECSORT,ECSTDT,ECENDDT ;112
I '$$ASKLOC^ECRUTL G ENQ
I '$$ASKDSS^ECRUTL G ENQ
I '$$ASKSRT(.ECSORT) G ENQ
I '$$STDT^ECRUTL G ENQ
I '$$ENDDT^ECRUTL(ECSTDT) G ENQ
I $$ASKDEV D STRPT^ECRDSSA
ENQ Q
;
STRPT ;Main entry point
N ECCRT ;is CRT?
N ECPAGE ;page cnt
S ECPAGE=0
S ECCRT=$S($E(IOST,1,2)="C-":1,1:0)
I $G(ECPTYP)'="E" U IO ;119 open device if not exporting
K ^TMP("ECRPT",$J)
D FNDREC(ECSORT)
D PRINT(ECSORT)
K ^TMP("ECRPT",$J) D ^ECKILL ;119
Q
;
FNDREC(ECSRT) ;Loop through "ADT" xref of EVENT CAPTURE PATIENT (#721) file
; Input:
; ECSRT - sort type
;
; Output: none
;
N ECNT ;record cnt
N ECL ;location cnt
N ECD ;DSS unit cnt
N ECDFN ;DFN
N ECLOCF ;Location IEN
N ECDSSF ;DSS unit IEN
N ECDT ;date index
N ECREC ;"0" node
N ECIEN ;IEN of file 721 ;patch 119
S ECNT=0
;
S ECL=0
F S ECL=$O(ECLOC(ECL)) Q:'ECL S ECLOCF=+$P(ECLOC(ECL),U) D
. S ^TMP("ECRPT",$J,ECLOCF)=0 ;initialize location counter
. S ECD=0
. F S ECD=$O(ECDSSU(ECD)) Q:'ECD S ECDSSF=+$P(ECDSSU(ECD),U) D
. . S ^TMP("ECRPT",$J,ECLOCF,ECDSSF)=0 ;initialize DSS Unit counter
. S ECDFN=0
. F S ECDFN=+$O(^ECH("ADT",ECLOCF,ECDFN)) Q:'ECDFN D
. . S ECD=0
. . F S ECD=$O(ECDSSU(ECD)) Q:'ECD S ECDSSF=+$P(ECDSSU(ECD),U) D
. . . S ECDT=ECSTDT
. . . F S ECDT=+$O(^ECH("ADT",ECLOCF,ECDFN,ECDSSF,ECDT)) Q:'ECDT!(ECDT>ECENDDT) D
. . . . S ECIEN=0
. . . . F S ECIEN=+$O(^ECH("ADT",ECLOCF,ECDFN,ECDSSF,ECDT,ECIEN)) Q:'ECIEN D
. . . . . I $P($G(^ECH(ECIEN,0)),U,7)=ECDSSF D BLDTMP(ECIEN,ECSRT,.ECNT)
Q
;
BLDTMP(ECIEN,ECSRT,ECCNT) ;add record to list
; Input:
; ECIEN - pointer to EVENT CAPTURE PATIENT (#721) file
; ECSRT - sort type
; ECCNT - record counter
;
; Output:
; ^TMP("ECRPT",$J,location,DSS unit,sort key1,sort key2,count)
;
N ECLOCA ;location
N ECDSS ;DSS unit
N ECIENS ;IENS
N ECKEY ;sort key array
N ECREC ;record string
N ECERR ;FM error
N ECDT ;date
N CLNODE ;Clinic zero node from 728.44
N ECACLN ;Clinic name
I +$G(ECIEN)>0,$$GETKEYS(ECSRT,ECIEN,.ECKEY) D
. S ECCNT=+$G(ECCNT)+1
. S ECIENS=ECIEN_","
. S ECREC=""
. D GETS^DIQ(721,ECIENS,"1;2;3;6;7;8;9;10;20;26;29","IE","ECREC","ECERR") ;126 Added category (#7), 134 added Assoc. Clin (#26)
. S ECACLN=$G(ECREC(721,ECIENS,26,"E")) ;134
. S CLNODE=$G(^ECX(728.44,+$G(ECREC(721,ECIENS,26,"I")),0)) ;134
. S ECLOCA=+$G(ECREC(721,ECIENS,3,"I"))
. S ECDSS=+$G(ECREC(721,ECIENS,6,"I"))
. S ECREC=ECREC_$E($G(ECREC(721,ECIENS,1,"E")),1,30)_"^" ;pt name
. S ECREC=ECREC_$E($$GETSSN(ECIEN),1,10)_"^" ;ssn
. S ECREC=ECREC_$E($G(ECREC(721,ECIENS,29,"I")),1)_"^" ;in/out
. S ECREC=ECREC_$E($G(ECREC(721,ECIENS,2,"I")),1,13)_"^" ;dt/tm
. S ECDT=$P($G(ECREC(721,ECIENS,2,"I")),".",1)
. S ECREC=ECREC_$E($$GETPROC($G(ECREC(721,ECIENS,8,"I"))),1,5)_"^" ;proc code
. S ECREC=ECREC_$$GETPRNM($G(ECREC(721,ECIENS,8,"I")),ECDT)_"^" ;126, get full proc name
. S ECREC=ECREC_$$GETPSYN(ECLOCA,ECDSS,+$G(ECREC(721,ECIENS,7,"I")),$G(ECREC(721,ECIENS,8,"I")))_"^" ;126 Get procedure synonym
. S ECREC=ECREC_$E($G(ECREC(721,ECIENS,9,"I")),1,2)_"^" ;vol
. S ECREC=ECREC_$E($$GETPROV(ECIEN),1,30)_"^" ;provider
. S ECREC=ECREC_$E($G(ECREC(721,ECIENS,20,"E")),1,8)_U ;dx 131, allow more space,134 add trailing ^
. S ECREC=ECREC_ECACLN_U_$P(CLNODE,U,2)_U_$P(CLNODE,U,3)_U_$P($G(^ECX(728.441,+$P(CLNODE,U,8),0)),U) ;134
. S ^TMP("ECRPT",$J,ECLOCA,ECDSS,ECKEY(1),ECKEY(2),ECNT)=ECREC
. S ^TMP("ECRPT",$J,ECLOCA)=$G(^TMP("ECRPT",$J,ECLOCA))+1
. S ^TMP("ECRPT",$J,ECLOCA,ECDSS)=$G(^TMP("ECRPT",$J,ECLOCA,ECDSS))+1
Q
;
PRINT(ECSRT) ;loop results array and format output
; Input:
; ECSRT - sort type
;
; Output: none
;
N ECCLOC ;current location
N ECPLOC ;previous location
N ECLOCNM ;location name
N ECCDSS ;current DSS unit
N ECPDSS ;previous DSS unit
N ECDSSNM ;DSS unit name
N ECCNT ;record count
N ECDAT ;procedure date/time
N ECRDT ;run date
N ECFDT ;from date
N ECTDT ;to date
N ECKEY1 ;sort key 1
N ECKEY2 ;sort key 2
N ECSRTBY ;sort type text
N ECQUIT ;user quit indicator
N ECREC ;tmp record data
N CNT,PIECE ;119 array count for data, record piece
I $G(ECPTYP)="E" D ;134
.S ^TMP($J,"ECRPT",1)="LOCATION^DSS UNIT (IEN #)^PATIENT^SSN^I/O^DATE/TIME^CLINIC^STOP CODE^CREDIT STOP^CHAR4" ;119,126,134
.S ^TMP($J,"ECRPT",1)=^TMP($J,"ECRPT",1)_"^PROCEDURE CODE^PROCEDURE NAME^SYNONYM^VOLUME^PRIMARY PROVIDER^DIAGNOSIS",CNT=1 ;119,126,134 Export header
I '$D(^TMP("ECRPT",$J)) G PRINTQ
S ECRDT=$$FMTE^XLFDT($$NOW^XLFDT,"5DZ")
S ECFDT=$$FMTE^XLFDT($P(ECSTDT+.0001,"."),"5DZ")
S ECTDT=$$FMTE^XLFDT($P(ECENDDT,"."),"5DZ")
S ECSRTBY=$S(ECSRT="P":"Patient Name",ECSRT="R":"Provider Name",ECSRT="S":"Patient SSN",1:"")
S (ECCLOC,ECPLOC,ECQUIT)=0
F S ECCLOC=$O(^TMP("ECRPT",$J,ECCLOC)) Q:'ECCLOC!(ECQUIT) D
. I ECCLOC'=ECPLOC D ;location changed
. . S ECPLOC=ECCLOC
. . S ECLOCNM=$$GETLOCN(ECCLOC,.ECLOC)
. . I $G(ECPTYP)'="E" I $O(^TMP("ECRPT",$J,ECCLOC,0))>0 D:ECPAGE>0 PAUSE Q:ECQUIT D HDR(ECLOCNM,ECRDT,ECFDT,ECTDT,ECSRTBY) ;119
. I $G(ECPTYP)'="E" I $G(^TMP("ECRPT",$J,ECCLOC))=0 D Q ;119
. . W !!," ** No records found on Location that match selection criteria"
. S (ECCDSS,ECPDSS)=0
. F S ECCDSS=$O(^TMP("ECRPT",$J,ECCLOC,ECCDSS)) Q:'ECCDSS!(ECQUIT) D
. . I ECCDSS'=ECPDSS D Q:ECQUIT ;dss unit changed
. . . S ECPDSS=ECCDSS
. . . S ECDSSNM=$$GETDSSN(ECCDSS,.ECDSSU)
. . . I $G(ECPTYP)'="E" I $Y>(IOSL-10) D PAUSE Q:ECQUIT D HDR(ECLOCNM,ECRDT,ECFDT,ECTDT,ECSRTBY) ;119
. . . I $G(ECPTYP)'="E" D DSSHDR(ECCDSS,ECDSSNM) ;119
. . I $G(ECPTYP)'="E" I $G(^TMP("ECRPT",$J,ECCLOC,ECCDSS))=0 D Q ;119
. . . W !,"** No records found on DSS Unit that match selection criteria"
. . S ECKEY1=""
. . F S ECKEY1=$O(^TMP("ECRPT",$J,ECCLOC,ECCDSS,ECKEY1)) Q:ECKEY1=""!(ECQUIT) D
. . . S ECKEY2=""
. . . F S ECKEY2=$O(^TMP("ECRPT",$J,ECCLOC,ECCDSS,ECKEY1,ECKEY2)) Q:ECKEY2=""!(ECQUIT) D
. . . . S ECCNT=0
. . . . F S ECCNT=$O(^TMP("ECRPT",$J,ECCLOC,ECCDSS,ECKEY1,ECKEY2,ECCNT)) Q:'ECCNT!(ECQUIT) D
. . . . . I $G(ECPTYP)'="E" I $Y>(IOSL-7) D PAUSE Q:ECQUIT D HDR(ECLOCNM,ECRDT,ECFDT,ECTDT,ECSRTBY),DSSHDR(ECCDSS,ECDSSNM) W " (cont'd)" ;119
. . . . . S ECREC=^TMP("ECRPT",$J,ECCLOC,ECCDSS,ECKEY1,ECKEY2,ECCNT)
. . . . . I $G(ECPTYP)="E" S CNT=CNT+1 S ^TMP($J,"ECRPT",CNT)=ECLOCNM_U_ECDSSNM_"(IEN #"_ECCDSS_")" D Q ;119
. . . . . . F PIECE=1:1:4,11:1:14,5:1:10 S ^TMP($J,"ECRPT",CNT)=^TMP($J,"ECRPT",CNT)_U_$S(PIECE'=4:$P(ECREC,U,PIECE),1:$$FMTE^XLFDT($P(ECREC,U,PIECE),"2MZ")) ;119,126,134
. . . . . W !,$P(ECREC,U,1) ;name
. . . . . W ?27,$P(ECREC,U,2) ;126 ssn
. . . . . W ?36,$P(ECREC,U,3) ;126 inpt/outpt
. . . . . S ECDAT=$$FMTE^XLFDT($P(ECREC,U,4),"2MZ")
. . . . . W ?40,$P(ECDAT,":")_$P(ECDAT,":",2) ;126 dt/tm
. . . . . W ?54,$P(ECREC,U,5) ;126 proc code
. . . . . W ?60,$P(ECREC,U,6) ;126 proc name
. . . . . W ?112,$P(ECREC,U,8) ;119,126 vol
. . . . . W ?118,$P(ECREC,U,10) ;126 dx
. . . . . W !,?36,$P(ECREC,U,11) ;134 Clinic
. . . . . W ?68,$P(ECREC,U,12) ;134 Stop Code
. . . . . W ?74,$P(ECREC,U,13) ;134 Credit Stop Code
. . . . . W ?82,$P(ECREC,U,14) ;134 CHAR4 code
. . . . . W !?4,$P(ECREC,U,9) ;126 Provider
. . . . . W ?60,$P(ECREC,U,7) ;126 Synonym
I $G(ECPTYP)'="E" I 'ECQUIT D PAUSE ;119
PRINTQ Q
;
HDR(ECLOCN,ECRDT,ECFDT,ECTDT,ECSRT) ;Report header
; Input:
; ECLOCN - location name
; ECRDT - run date
; EDFDT - from date
; EDTDT - to date
; ECSRT - sort text
;
; Output: none
;
I ECCRT!(ECPAGE) W @IOF
S ECPAGE=ECPAGE+1
W !,?11,"EVENT CAPTURE DSS UNIT ACTIVITY REPORT"
W ?58,"Run Date: ",ECRDT
W ?109,"Page: ",ECPAGE
W !!,?13,"For Location ",ECLOCN
W !,?13,"From "_ECFDT_" through "_ECTDT
W !,?13,"Sorted by ",ECSRT
W !!,"Patient",?27,"SSN",?36,"I/O",?40,"Date/Time",?54,"Procedure",?112,"Vol",?118,"Primary" ;126
W !?54,"Code",?60,"Name",?118,"Diagnosis" ;126
W !,?36,"CLINIC",?68,"STOP",?74,"CREDIT",?82,"CHAR4" ;134
W !?4,"Primary Provider",?60,"Synonym",!,$$REPEAT^XLFSTR("-",132) ;126
Q
;
DSSHDR(ECDSS,ECDSSNM) ;DSS header
; Input:
; ECDSS - DSS unit
; ECDSSNM - DSS unit name
;
; Output: none
;
W !!,"DSS Unit: ",ECDSSNM," (IEN #",ECDSS,")"
Q
;
PAUSE ;page break
N DIR,DIRUT,DUOUT
D FOOTER
Q:'ECCRT
I IOSL<30 F W ! Q:$Y>(IOSL-7)
W !
S DIR(0)="E"
D ^DIR
I $D(DIRUT)!($D(DUOUT)) S ECQUIT=1
Q
;
W !!?4,"Volume totals may represent days, minutes, numbers of procedures"
W " and/or a combination of these.",! ;149,134
Q
;
GETLOCN(ECLOCA,ECLOC) ;get location name
; Input:
; ECLOCA - location
; ECLOC - array of selected locations
;
; Output:
; Function value - returns location name on success; "" on failure
;
N ECI
N ECLOCNM
S ECLOCNM=""
I +$G(ECLOCA)>0 D
. S ECI=0
. F S ECI=$O(ECLOC(ECI)) Q:'ECI!(ECLOCNM'="") D
. . I $P(ECLOC(ECI),U)=ECLOCA S ECLOCNM=$P(ECLOC(ECI),U,2)
Q ECLOCNM
;
GETDSSN(ECDSS,ECDSSU) ;-get DSS unit name
; Input:
; ECDSS - DSS unit
; ECDSSU - array of selected DSS units
;
; Output:
; Function value - returns DSS unit name on success; "" on failure
;
N ECI
N ECDSSNM
S ECDSSNM=""
I +$G(ECDSS)>0 D
. S ECI=0
. F S ECI=$O(ECDSSU(ECI)) Q:'ECI!(ECDSSNM'="") D
. . I $P(ECDSSU(ECI),U)=ECDSS S ECDSSNM=$P(ECDSSU(ECI),U,2)
Q ECDSSNM
;
GETKEYS(ECSRT,ECIEN,ECKEYS) ;get sort keys based on sort type
; Input:
; ECSRT - (required) sort type indicator (P, S, R)
; ECIEN - (required) pointer to EVENT CAPTURE PATIENT (#721) file
;
; Output:
; ECKEYS - (pass by reference) array of sort keys
; Function value - returns 1 on success;0 on failure
;
N ECRSLT ;function value
S ECRSLT=0
S (ECKEYS(1),ECKEYS(2))=""
I $G(ECSRT)'="",+$G(ECIEN)>0 D
. I ECSRT="P" D
. . S ECKEYS(1)=$$GET1^DIQ(721,ECIEN_",",1) ;name
. . S ECKEYS(2)=$E($$GETSSN(ECIEN),1,9) ;ssn
. I ECSRT="R" D
. . S ECKEYS(1)=$$GETPROV(ECIEN) ;provider
. . I ECKEYS(1)="" S ECKEYS(1)=" " ;missing provider sorts to top
. . S ECKEYS(2)=$$GET1^DIQ(721,ECIEN_",",1) ;name
. I ECSRT="S" D
. . S ECKEYS(1)=$E($$GETSSN(ECIEN),1,9) ;ssn
. . S ECKEYS(2)=$$GET1^DIQ(721,ECIEN_",",1) ;name
. I ECKEYS(1)'="",ECKEYS(2)'="" S ECRSLT=1
Q ECRSLT
;
GETSSN(ECIEN) ;get patient SSN
; Input:
; ECIEN - (required) pointer to EVENT CAPTURE PATIENT (#721) file
;
; Output:
; Function value - returns patient's SSN on success; "" on failure
;
N DFN,VADM,VAERR ;VADPT variables
I +$G(ECIEN)>0 D
. S DFN=$$GET1^DIQ(721,ECIEN_",",1,"I")
. D DEM^VADPT
I $G(ECPTYP)="E" Q $P($G(VADM(2)),U) ;119 full SSN on export
Q $E($P($G(VADM(2)),U),6,9) ;112, only get last 4 SSN
;
GETPROV(ECIEN) ;get primary provider
;This function retrieves the primary provider for a given Event
;Capture record. Searches the PROVIDER MULTIPLE (#42) field first
;and falls back to the PROVIDER (#10) field.
; Input:
; ECIEN -(required) pointer to EVENT CAPTURE PATIENT (#721) file
;
; Output:
; Function value - returns provider's name on success; "" on failure
;
N ECPROV ;provider name
S ECPROV=""
I $G(ECIEN)'="",$D(^ECH(ECIEN)) D
. ;try PROVIDER MULTIPLE
. I '$$GETPPRV^ECPRVMUT(ECIEN,.ECPROV) D ;api returns "0" on success
. . S ECPROV=$P(ECPROV,U,2)
. E D ;try PROVIDER
. . S ECPROV=$$GET1^DIQ(721,ECIEN_",",10)
Q ECPROV
;
GETPRNM(ECVIEN,ECDT) ;get procedure name
; Input:
; ECVIEN - variable pointer to CPT (#81) file or EC PROC file
;
; Output:
; Function value - returns procedure name on success; "" on failure
;
N ECIEN ;IEN part of variable pointer
N ECFILE ;file part of variable pointer
S ECIEN=$P(ECVIEN,";",1)
S ECFILE=$P(ECVIEN,";",2)
Q $S(ECFILE["ICPT(":$P($$CPT^ICPTCOD(ECIEN,ECDT),U,3),ECFILE["EC(725":$$GET1^DIQ(725,ECIEN_",",.01),1:"")
;
GETPROC(ECVIEN) ;get procedure code
; Input:
; ECVIEN - variable pointer to CPT (#81) file or EC PROC file
;
; Output:
; Function value - returns procedure code on success; "" on failure
;
N ECIEN ;IEN part of variable pointer
N ECFILE ;file part of variable pointer
S ECIEN=$P(ECVIEN,";",1)
S ECFILE=$P(ECVIEN,";",2)
Q $S(ECFILE["ICPT(":$$GET1^DIQ(81,ECIEN_",",.01),ECFILE["EC(725":$$GET1^DIQ(725,ECIEN_",",1),1:"")
;
GETPSYN(LOC,UNIT,CAT,PROC) ;API added in 126, gets synonym for EC screen
N SYN,IEN
S SYN=""
I PROC="" Q SYN
S IEN=$O(^ECJ("AP",LOC,UNIT,CAT,PROC,0))
I IEN="" Q SYN
Q $P($G(^ECJ(IEN,"PRO")),U,2)
;
ASKSRT(ECTYP) ;Ask report sort type
; Input: none
;
; Output:
; ECTYP - (pass by reference) Sort type
; (P: Patient Name,S: SSN,R: Provider Name)
; Function value - returns 1 on success; 0 on failure
;
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y ;^DIR variables
S DIR(0)="SA^P:PATIENT NAME;S:SSN;R:PROVIDER NAME"
S DIR("A")="Sort within each DSS Unit by: "
S DIR("B")="SSN"
D ^DIR
S ECTYP=$P(Y,U)
Q $S($D(DUOUT):0,$D(DTOUT):0,$D(DIROUT):0,1:1)
;
ASKDEV() ;Ask output device
; Input: none
;
; Output: 1 if report is printed
; 0 if report is queued (or exited)
;
N ECX,ZTDESC,ZTRTN,ZTSAVE
S ECX=1
K %ZIS S %ZIS="QMP"
D ^%ZIS
S:POP ECX=0
I ECX&($D(IO("Q"))) D
. S ZTRTN="STRPT^ECRDSSA",ZTDESC="DSS UNIT ACTIVITY REPORT"
. S (ZTSAVE("ECLOC("),ZTSAVE("ECDSSU("),ZTSAVE("ECSRT"))=""
. S (ZTSAVE("ECSTDT"),ZTSAVE("ECENDDT"))=""
. D ^%ZTLOAD
. D HOME^%ZIS
. S ECX=0
Q ECX
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECRDSSA 13962 printed Jan 18, 2025@02:59:43 Page 2
ECRDSSA ;ALB/RPM - DSS Unit Activity Report ;9/23/16 15:14
+1 ;;2.0;EVENT CAPTURE;**95,104,112,119,126,131,134**;8 May 96;Build 12
+2 ;
EN ;Get location(s), DSS Unit(s), sort type, start & end dates, device
+1 ;
+2 ;112
NEW ECLOC,ECDSSU,ECSORT,ECSTDT,ECENDDT
+3 IF '$$ASKLOC^ECRUTL
GOTO ENQ
+4 IF '$$ASKDSS^ECRUTL
GOTO ENQ
+5 IF '$$ASKSRT(.ECSORT)
GOTO ENQ
+6 IF '$$STDT^ECRUTL
GOTO ENQ
+7 IF '$$ENDDT^ECRUTL(ECSTDT)
GOTO ENQ
+8 IF $$ASKDEV
DO STRPT^ECRDSSA
ENQ QUIT
+1 ;
STRPT ;Main entry point
+1 ;is CRT?
NEW ECCRT
+2 ;page cnt
NEW ECPAGE
+3 SET ECPAGE=0
+4 SET ECCRT=$SELECT($EXTRACT(IOST,1,2)="C-":1,1:0)
+5 ;119 open device if not exporting
IF $GET(ECPTYP)'="E"
USE IO
+6 KILL ^TMP("ECRPT",$JOB)
+7 DO FNDREC(ECSORT)
+8 DO PRINT(ECSORT)
+9 ;119
KILL ^TMP("ECRPT",$JOB)
DO ^ECKILL
+10 QUIT
+11 ;
FNDREC(ECSRT) ;Loop through "ADT" xref of EVENT CAPTURE PATIENT (#721) file
+1 ; Input:
+2 ; ECSRT - sort type
+3 ;
+4 ; Output: none
+5 ;
+6 ;record cnt
NEW ECNT
+7 ;location cnt
NEW ECL
+8 ;DSS unit cnt
NEW ECD
+9 ;DFN
NEW ECDFN
+10 ;Location IEN
NEW ECLOCF
+11 ;DSS unit IEN
NEW ECDSSF
+12 ;date index
NEW ECDT
+13 ;"0" node
NEW ECREC
+14 ;IEN of file 721 ;patch 119
NEW ECIEN
+15 SET ECNT=0
+16 ;
+17 SET ECL=0
+18 FOR
SET ECL=$ORDER(ECLOC(ECL))
if 'ECL
QUIT
SET ECLOCF=+$PIECE(ECLOC(ECL),U)
Begin DoDot:1
+19 ;initialize location counter
SET ^TMP("ECRPT",$JOB,ECLOCF)=0
+20 SET ECD=0
+21 FOR
SET ECD=$ORDER(ECDSSU(ECD))
if 'ECD
QUIT
SET ECDSSF=+$PIECE(ECDSSU(ECD),U)
Begin DoDot:2
+22 ;initialize DSS Unit counter
SET ^TMP("ECRPT",$JOB,ECLOCF,ECDSSF)=0
End DoDot:2
+23 SET ECDFN=0
+24 FOR
SET ECDFN=+$ORDER(^ECH("ADT",ECLOCF,ECDFN))
if 'ECDFN
QUIT
Begin DoDot:2
+25 SET ECD=0
+26 FOR
SET ECD=$ORDER(ECDSSU(ECD))
if 'ECD
QUIT
SET ECDSSF=+$PIECE(ECDSSU(ECD),U)
Begin DoDot:3
+27 SET ECDT=ECSTDT
+28 FOR
SET ECDT=+$ORDER(^ECH("ADT",ECLOCF,ECDFN,ECDSSF,ECDT))
if 'ECDT!(ECDT>ECENDDT)
QUIT
Begin DoDot:4
+29 SET ECIEN=0
+30 FOR
SET ECIEN=+$ORDER(^ECH("ADT",ECLOCF,ECDFN,ECDSSF,ECDT,ECIEN))
if 'ECIEN
QUIT
Begin DoDot:5
+31 IF $PIECE($GET(^ECH(ECIEN,0)),U,7)=ECDSSF
DO BLDTMP(ECIEN,ECSRT,.ECNT)
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+32 QUIT
+33 ;
BLDTMP(ECIEN,ECSRT,ECCNT) ;add record to list
+1 ; Input:
+2 ; ECIEN - pointer to EVENT CAPTURE PATIENT (#721) file
+3 ; ECSRT - sort type
+4 ; ECCNT - record counter
+5 ;
+6 ; Output:
+7 ; ^TMP("ECRPT",$J,location,DSS unit,sort key1,sort key2,count)
+8 ;
+9 ;location
NEW ECLOCA
+10 ;DSS unit
NEW ECDSS
+11 ;IENS
NEW ECIENS
+12 ;sort key array
NEW ECKEY
+13 ;record string
NEW ECREC
+14 ;FM error
NEW ECERR
+15 ;date
NEW ECDT
+16 ;Clinic zero node from 728.44
NEW CLNODE
+17 ;Clinic name
NEW ECACLN
+18 IF +$GET(ECIEN)>0
IF $$GETKEYS(ECSRT,ECIEN,.ECKEY)
Begin DoDot:1
+19 SET ECCNT=+$GET(ECCNT)+1
+20 SET ECIENS=ECIEN_","
+21 SET ECREC=""
+22 ;126 Added category (#7), 134 added Assoc. Clin (#26)
DO GETS^DIQ(721,ECIENS,"1;2;3;6;7;8;9;10;20;26;29","IE","ECREC","ECERR")
+23 ;134
SET ECACLN=$GET(ECREC(721,ECIENS,26,"E"))
+24 ;134
SET CLNODE=$GET(^ECX(728.44,+$GET(ECREC(721,ECIENS,26,"I")),0))
+25 SET ECLOCA=+$GET(ECREC(721,ECIENS,3,"I"))
+26 SET ECDSS=+$GET(ECREC(721,ECIENS,6,"I"))
+27 ;pt name
SET ECREC=ECREC_$EXTRACT($GET(ECREC(721,ECIENS,1,"E")),1,30)_"^"
+28 ;ssn
SET ECREC=ECREC_$EXTRACT($$GETSSN(ECIEN),1,10)_"^"
+29 ;in/out
SET ECREC=ECREC_$EXTRACT($GET(ECREC(721,ECIENS,29,"I")),1)_"^"
+30 ;dt/tm
SET ECREC=ECREC_$EXTRACT($GET(ECREC(721,ECIENS,2,"I")),1,13)_"^"
+31 SET ECDT=$PIECE($GET(ECREC(721,ECIENS,2,"I")),".",1)
+32 ;proc code
SET ECREC=ECREC_$EXTRACT($$GETPROC($GET(ECREC(721,ECIENS,8,"I"))),1,5)_"^"
+33 ;126, get full proc name
SET ECREC=ECREC_$$GETPRNM($GET(ECREC(721,ECIENS,8,"I")),ECDT)_"^"
+34 ;126 Get procedure synonym
SET ECREC=ECREC_$$GETPSYN(ECLOCA,ECDSS,+$GET(ECREC(721,ECIENS,7,"I")),$GET(ECREC(721,ECIENS,8,"I")))_"^"
+35 ;vol
SET ECREC=ECREC_$EXTRACT($GET(ECREC(721,ECIENS,9,"I")),1,2)_"^"
+36 ;provider
SET ECREC=ECREC_$EXTRACT($$GETPROV(ECIEN),1,30)_"^"
+37 ;dx 131, allow more space,134 add trailing ^
SET ECREC=ECREC_$EXTRACT($GET(ECREC(721,ECIENS,20,"E")),1,8)_U
+38 ;134
SET ECREC=ECREC_ECACLN_U_$PIECE(CLNODE,U,2)_U_$PIECE(CLNODE,U,3)_U_$PIECE($GET(^ECX(728.441,+$PIECE(CLNODE,U,8),0)),U)
+39 SET ^TMP("ECRPT",$JOB,ECLOCA,ECDSS,ECKEY(1),ECKEY(2),ECNT)=ECREC
+40 SET ^TMP("ECRPT",$JOB,ECLOCA)=$GET(^TMP("ECRPT",$JOB,ECLOCA))+1
+41 SET ^TMP("ECRPT",$JOB,ECLOCA,ECDSS)=$GET(^TMP("ECRPT",$JOB,ECLOCA,ECDSS))+1
End DoDot:1
+42 QUIT
+43 ;
PRINT(ECSRT) ;loop results array and format output
+1 ; Input:
+2 ; ECSRT - sort type
+3 ;
+4 ; Output: none
+5 ;
+6 ;current location
NEW ECCLOC
+7 ;previous location
NEW ECPLOC
+8 ;location name
NEW ECLOCNM
+9 ;current DSS unit
NEW ECCDSS
+10 ;previous DSS unit
NEW ECPDSS
+11 ;DSS unit name
NEW ECDSSNM
+12 ;record count
NEW ECCNT
+13 ;procedure date/time
NEW ECDAT
+14 ;run date
NEW ECRDT
+15 ;from date
NEW ECFDT
+16 ;to date
NEW ECTDT
+17 ;sort key 1
NEW ECKEY1
+18 ;sort key 2
NEW ECKEY2
+19 ;sort type text
NEW ECSRTBY
+20 ;user quit indicator
NEW ECQUIT
+21 ;tmp record data
NEW ECREC
+22 ;119 array count for data, record piece
NEW CNT,PIECE
+23 ;134
IF $GET(ECPTYP)="E"
Begin DoDot:1
+24 ;119,126,134
SET ^TMP($JOB,"ECRPT",1)="LOCATION^DSS UNIT (IEN #)^PATIENT^SSN^I/O^DATE/TIME^CLINIC^STOP CODE^CREDIT STOP^CHAR4"
+25 ;119,126,134 Export header
SET ^TMP($JOB,"ECRPT",1)=^TMP($JOB,"ECRPT",1)_"^PROCEDURE CODE^PROCEDURE NAME^SYNONYM^VOLUME^PRIMARY PROVIDER^DIAGNOSIS"
SET CNT=1
End DoDot:1
+26 IF '$DATA(^TMP("ECRPT",$JOB))
GOTO PRINTQ
+27 SET ECRDT=$$FMTE^XLFDT($$NOW^XLFDT,"5DZ")
+28 SET ECFDT=$$FMTE^XLFDT($PIECE(ECSTDT+.0001,"."),"5DZ")
+29 SET ECTDT=$$FMTE^XLFDT($PIECE(ECENDDT,"."),"5DZ")
+30 SET ECSRTBY=$SELECT(ECSRT="P":"Patient Name",ECSRT="R":"Provider Name",ECSRT="S":"Patient SSN",1:"")
+31 SET (ECCLOC,ECPLOC,ECQUIT)=0
+32 FOR
SET ECCLOC=$ORDER(^TMP("ECRPT",$JOB,ECCLOC))
if 'ECCLOC!(ECQUIT)
QUIT
Begin DoDot:1
+33 ;location changed
IF ECCLOC'=ECPLOC
Begin DoDot:2
+34 SET ECPLOC=ECCLOC
+35 SET ECLOCNM=$$GETLOCN(ECCLOC,.ECLOC)
+36 ;119
IF $GET(ECPTYP)'="E"
IF $ORDER(^TMP("ECRPT",$JOB,ECCLOC,0))>0
if ECPAGE>0
DO PAUSE
if ECQUIT
QUIT
DO HDR(ECLOCNM,ECRDT,ECFDT,ECTDT,ECSRTBY)
End DoDot:2
+37 ;119
IF $GET(ECPTYP)'="E"
IF $GET(^TMP("ECRPT",$JOB,ECCLOC))=0
Begin DoDot:2
+38 WRITE !!," ** No records found on Location that match selection criteria"
End DoDot:2
QUIT
+39 SET (ECCDSS,ECPDSS)=0
+40 FOR
SET ECCDSS=$ORDER(^TMP("ECRPT",$JOB,ECCLOC,ECCDSS))
if 'ECCDSS!(ECQUIT)
QUIT
Begin DoDot:2
+41 ;dss unit changed
IF ECCDSS'=ECPDSS
Begin DoDot:3
+42 SET ECPDSS=ECCDSS
+43 SET ECDSSNM=$$GETDSSN(ECCDSS,.ECDSSU)
+44 ;119
IF $GET(ECPTYP)'="E"
IF $Y>(IOSL-10)
DO PAUSE
if ECQUIT
QUIT
DO HDR(ECLOCNM,ECRDT,ECFDT,ECTDT,ECSRTBY)
+45 ;119
IF $GET(ECPTYP)'="E"
DO DSSHDR(ECCDSS,ECDSSNM)
End DoDot:3
if ECQUIT
QUIT
+46 ;119
IF $GET(ECPTYP)'="E"
IF $GET(^TMP("ECRPT",$JOB,ECCLOC,ECCDSS))=0
Begin DoDot:3
+47 WRITE !,"** No records found on DSS Unit that match selection criteria"
End DoDot:3
QUIT
+48 SET ECKEY1=""
+49 FOR
SET ECKEY1=$ORDER(^TMP("ECRPT",$JOB,ECCLOC,ECCDSS,ECKEY1))
if ECKEY1=""!(ECQUIT)
QUIT
Begin DoDot:3
+50 SET ECKEY2=""
+51 FOR
SET ECKEY2=$ORDER(^TMP("ECRPT",$JOB,ECCLOC,ECCDSS,ECKEY1,ECKEY2))
if ECKEY2=""!(ECQUIT)
QUIT
Begin DoDot:4
+52 SET ECCNT=0
+53 FOR
SET ECCNT=$ORDER(^TMP("ECRPT",$JOB,ECCLOC,ECCDSS,ECKEY1,ECKEY2,ECCNT))
if 'ECCNT!(ECQUIT)
QUIT
Begin DoDot:5
+54 ;119
IF $GET(ECPTYP)'="E"
IF $Y>(IOSL-7)
DO PAUSE
if ECQUIT
QUIT
DO HDR(ECLOCNM,ECRDT,ECFDT,ECTDT,ECSRTBY)
DO DSSHDR(ECCDSS,ECDSSNM)
WRITE " (cont'd)"
+55 SET ECREC=^TMP("ECRPT",$JOB,ECCLOC,ECCDSS,ECKEY1,ECKEY2,ECCNT)
+56 ;119
IF $GET(ECPTYP)="E"
SET CNT=CNT+1
SET ^TMP($JOB,"ECRPT",CNT)=ECLOCNM_U_ECDSSNM_"(IEN #"_ECCDSS_")"
Begin DoDot:6
+57 ;119,126,134
FOR PIECE=1:1:4,11:1:14,5:1:10
SET ^TMP($JOB,"ECRPT",CNT)=^TMP($JOB,"ECRPT",CNT)_U_$SELECT(PIECE'=4:$PIECE(ECREC,U,PIECE),1:$$FMTE^XLFDT($PIECE(ECREC,U,PIECE),"2MZ"))
End DoDot:6
QUIT
+58 ;name
WRITE !,$PIECE(ECREC,U,1)
+59 ;126 ssn
WRITE ?27,$PIECE(ECREC,U,2)
+60 ;126 inpt/outpt
WRITE ?36,$PIECE(ECREC,U,3)
+61 SET ECDAT=$$FMTE^XLFDT($PIECE(ECREC,U,4),"2MZ")
+62 ;126 dt/tm
WRITE ?40,$PIECE(ECDAT,":")_$PIECE(ECDAT,":",2)
+63 ;126 proc code
WRITE ?54,$PIECE(ECREC,U,5)
+64 ;126 proc name
WRITE ?60,$PIECE(ECREC,U,6)
+65 ;119,126 vol
WRITE ?112,$PIECE(ECREC,U,8)
+66 ;126 dx
WRITE ?118,$PIECE(ECREC,U,10)
+67 ;134 Clinic
WRITE !,?36,$PIECE(ECREC,U,11)
+68 ;134 Stop Code
WRITE ?68,$PIECE(ECREC,U,12)
+69 ;134 Credit Stop Code
WRITE ?74,$PIECE(ECREC,U,13)
+70 ;134 CHAR4 code
WRITE ?82,$PIECE(ECREC,U,14)
+71 ;126 Provider
WRITE !?4,$PIECE(ECREC,U,9)
+72 ;126 Synonym
WRITE ?60,$PIECE(ECREC,U,7)
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+73 ;119
IF $GET(ECPTYP)'="E"
IF 'ECQUIT
DO PAUSE
PRINTQ QUIT
+1 ;
HDR(ECLOCN,ECRDT,ECFDT,ECTDT,ECSRT) ;Report header
+1 ; Input:
+2 ; ECLOCN - location name
+3 ; ECRDT - run date
+4 ; EDFDT - from date
+5 ; EDTDT - to date
+6 ; ECSRT - sort text
+7 ;
+8 ; Output: none
+9 ;
+10 IF ECCRT!(ECPAGE)
WRITE @IOF
+11 SET ECPAGE=ECPAGE+1
+12 WRITE !,?11,"EVENT CAPTURE DSS UNIT ACTIVITY REPORT"
+13 WRITE ?58,"Run Date: ",ECRDT
+14 WRITE ?109,"Page: ",ECPAGE
+15 WRITE !!,?13,"For Location ",ECLOCN
+16 WRITE !,?13,"From "_ECFDT_" through "_ECTDT
+17 WRITE !,?13,"Sorted by ",ECSRT
+18 ;126
WRITE !!,"Patient",?27,"SSN",?36,"I/O",?40,"Date/Time",?54,"Procedure",?112,"Vol",?118,"Primary"
+19 ;126
WRITE !?54,"Code",?60,"Name",?118,"Diagnosis"
+20 ;134
WRITE !,?36,"CLINIC",?68,"STOP",?74,"CREDIT",?82,"CHAR4"
+21 ;126
WRITE !?4,"Primary Provider",?60,"Synonym",!,$$REPEAT^XLFSTR("-",132)
+22 QUIT
+23 ;
DSSHDR(ECDSS,ECDSSNM) ;DSS header
+1 ; Input:
+2 ; ECDSS - DSS unit
+3 ; ECDSSNM - DSS unit name
+4 ;
+5 ; Output: none
+6 ;
+7 WRITE !!,"DSS Unit: ",ECDSSNM," (IEN #",ECDSS,")"
+8 QUIT
+9 ;
PAUSE ;page break
+1 NEW DIR,DIRUT,DUOUT
+2 DO FOOTER
+3 if 'ECCRT
QUIT
+4 IF IOSL<30
FOR
WRITE !
if $Y>(IOSL-7)
QUIT
+5 WRITE !
+6 SET DIR(0)="E"
+7 DO ^DIR
+8 IF $DATA(DIRUT)!($DATA(DUOUT))
SET ECQUIT=1
+9 QUIT
+10 ;
+1 WRITE !!?4,"Volume totals may represent days, minutes, numbers of procedures"
+2 ;149,134
WRITE " and/or a combination of these.",!
+3 QUIT
+4 ;
GETLOCN(ECLOCA,ECLOC) ;get location name
+1 ; Input:
+2 ; ECLOCA - location
+3 ; ECLOC - array of selected locations
+4 ;
+5 ; Output:
+6 ; Function value - returns location name on success; "" on failure
+7 ;
+8 NEW ECI
+9 NEW ECLOCNM
+10 SET ECLOCNM=""
+11 IF +$GET(ECLOCA)>0
Begin DoDot:1
+12 SET ECI=0
+13 FOR
SET ECI=$ORDER(ECLOC(ECI))
if 'ECI!(ECLOCNM'="")
QUIT
Begin DoDot:2
+14 IF $PIECE(ECLOC(ECI),U)=ECLOCA
SET ECLOCNM=$PIECE(ECLOC(ECI),U,2)
End DoDot:2
End DoDot:1
+15 QUIT ECLOCNM
+16 ;
GETDSSN(ECDSS,ECDSSU) ;-get DSS unit name
+1 ; Input:
+2 ; ECDSS - DSS unit
+3 ; ECDSSU - array of selected DSS units
+4 ;
+5 ; Output:
+6 ; Function value - returns DSS unit name on success; "" on failure
+7 ;
+8 NEW ECI
+9 NEW ECDSSNM
+10 SET ECDSSNM=""
+11 IF +$GET(ECDSS)>0
Begin DoDot:1
+12 SET ECI=0
+13 FOR
SET ECI=$ORDER(ECDSSU(ECI))
if 'ECI!(ECDSSNM'="")
QUIT
Begin DoDot:2
+14 IF $PIECE(ECDSSU(ECI),U)=ECDSS
SET ECDSSNM=$PIECE(ECDSSU(ECI),U,2)
End DoDot:2
End DoDot:1
+15 QUIT ECDSSNM
+16 ;
GETKEYS(ECSRT,ECIEN,ECKEYS) ;get sort keys based on sort type
+1 ; Input:
+2 ; ECSRT - (required) sort type indicator (P, S, R)
+3 ; ECIEN - (required) pointer to EVENT CAPTURE PATIENT (#721) file
+4 ;
+5 ; Output:
+6 ; ECKEYS - (pass by reference) array of sort keys
+7 ; Function value - returns 1 on success;0 on failure
+8 ;
+9 ;function value
NEW ECRSLT
+10 SET ECRSLT=0
+11 SET (ECKEYS(1),ECKEYS(2))=""
+12 IF $GET(ECSRT)'=""
IF +$GET(ECIEN)>0
Begin DoDot:1
+13 IF ECSRT="P"
Begin DoDot:2
+14 ;name
SET ECKEYS(1)=$$GET1^DIQ(721,ECIEN_",",1)
+15 ;ssn
SET ECKEYS(2)=$EXTRACT($$GETSSN(ECIEN),1,9)
End DoDot:2
+16 IF ECSRT="R"
Begin DoDot:2
+17 ;provider
SET ECKEYS(1)=$$GETPROV(ECIEN)
+18 ;missing provider sorts to top
IF ECKEYS(1)=""
SET ECKEYS(1)=" "
+19 ;name
SET ECKEYS(2)=$$GET1^DIQ(721,ECIEN_",",1)
End DoDot:2
+20 IF ECSRT="S"
Begin DoDot:2
+21 ;ssn
SET ECKEYS(1)=$EXTRACT($$GETSSN(ECIEN),1,9)
+22 ;name
SET ECKEYS(2)=$$GET1^DIQ(721,ECIEN_",",1)
End DoDot:2
+23 IF ECKEYS(1)'=""
IF ECKEYS(2)'=""
SET ECRSLT=1
End DoDot:1
+24 QUIT ECRSLT
+25 ;
GETSSN(ECIEN) ;get patient SSN
+1 ; Input:
+2 ; ECIEN - (required) pointer to EVENT CAPTURE PATIENT (#721) file
+3 ;
+4 ; Output:
+5 ; Function value - returns patient's SSN on success; "" on failure
+6 ;
+7 ;VADPT variables
NEW DFN,VADM,VAERR
+8 IF +$GET(ECIEN)>0
Begin DoDot:1
+9 SET DFN=$$GET1^DIQ(721,ECIEN_",",1,"I")
+10 DO DEM^VADPT
End DoDot:1
+11 ;119 full SSN on export
IF $GET(ECPTYP)="E"
QUIT $PIECE($GET(VADM(2)),U)
+12 ;112, only get last 4 SSN
QUIT $EXTRACT($PIECE($GET(VADM(2)),U),6,9)
+13 ;
GETPROV(ECIEN) ;get primary provider
+1 ;This function retrieves the primary provider for a given Event
+2 ;Capture record. Searches the PROVIDER MULTIPLE (#42) field first
+3 ;and falls back to the PROVIDER (#10) field.
+4 ; Input:
+5 ; ECIEN -(required) pointer to EVENT CAPTURE PATIENT (#721) file
+6 ;
+7 ; Output:
+8 ; Function value - returns provider's name on success; "" on failure
+9 ;
+10 ;provider name
NEW ECPROV
+11 SET ECPROV=""
+12 IF $GET(ECIEN)'=""
IF $DATA(^ECH(ECIEN))
Begin DoDot:1
+13 ;try PROVIDER MULTIPLE
+14 ;api returns "0" on success
IF '$$GETPPRV^ECPRVMUT(ECIEN,.ECPROV)
Begin DoDot:2
+15 SET ECPROV=$PIECE(ECPROV,U,2)
End DoDot:2
+16 ;try PROVIDER
IF '$TEST
Begin DoDot:2
+17 SET ECPROV=$$GET1^DIQ(721,ECIEN_",",10)
End DoDot:2
End DoDot:1
+18 QUIT ECPROV
+19 ;
GETPRNM(ECVIEN,ECDT) ;get procedure name
+1 ; Input:
+2 ; ECVIEN - variable pointer to CPT (#81) file or EC PROC file
+3 ;
+4 ; Output:
+5 ; Function value - returns procedure name on success; "" on failure
+6 ;
+7 ;IEN part of variable pointer
NEW ECIEN
+8 ;file part of variable pointer
NEW ECFILE
+9 SET ECIEN=$PIECE(ECVIEN,";",1)
+10 SET ECFILE=$PIECE(ECVIEN,";",2)
+11 QUIT $SELECT(ECFILE["ICPT(":$PIECE($$CPT^ICPTCOD(ECIEN,ECDT),U,3),ECFILE["EC(725":$$GET1^DIQ(725,ECIEN_",",.01),1:"")
+12 ;
GETPROC(ECVIEN) ;get procedure code
+1 ; Input:
+2 ; ECVIEN - variable pointer to CPT (#81) file or EC PROC file
+3 ;
+4 ; Output:
+5 ; Function value - returns procedure code on success; "" on failure
+6 ;
+7 ;IEN part of variable pointer
NEW ECIEN
+8 ;file part of variable pointer
NEW ECFILE
+9 SET ECIEN=$PIECE(ECVIEN,";",1)
+10 SET ECFILE=$PIECE(ECVIEN,";",2)
+11 QUIT $SELECT(ECFILE["ICPT(":$$GET1^DIQ(81,ECIEN_",",.01),ECFILE["EC(725":$$GET1^DIQ(725,ECIEN_",",1),1:"")
+12 ;
GETPSYN(LOC,UNIT,CAT,PROC) ;API added in 126, gets synonym for EC screen
+1 NEW SYN,IEN
+2 SET SYN=""
+3 IF PROC=""
QUIT SYN
+4 SET IEN=$ORDER(^ECJ("AP",LOC,UNIT,CAT,PROC,0))
+5 IF IEN=""
QUIT SYN
+6 QUIT $PIECE($GET(^ECJ(IEN,"PRO")),U,2)
+7 ;
ASKSRT(ECTYP) ;Ask report sort type
+1 ; Input: none
+2 ;
+3 ; Output:
+4 ; ECTYP - (pass by reference) Sort type
+5 ; (P: Patient Name,S: SSN,R: Provider Name)
+6 ; Function value - returns 1 on success; 0 on failure
+7 ;
+8 ;^DIR variables
NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+9 SET DIR(0)="SA^P:PATIENT NAME;S:SSN;R:PROVIDER NAME"
+10 SET DIR("A")="Sort within each DSS Unit by: "
+11 SET DIR("B")="SSN"
+12 DO ^DIR
+13 SET ECTYP=$PIECE(Y,U)
+14 QUIT $SELECT($DATA(DUOUT):0,$DATA(DTOUT):0,$DATA(DIROUT):0,1:1)
+15 ;
ASKDEV() ;Ask output device
+1 ; Input: none
+2 ;
+3 ; Output: 1 if report is printed
+4 ; 0 if report is queued (or exited)
+5 ;
+6 NEW ECX,ZTDESC,ZTRTN,ZTSAVE
+7 SET ECX=1
+8 KILL %ZIS
SET %ZIS="QMP"
+9 DO ^%ZIS
+10 if POP
SET ECX=0
+11 IF ECX&($DATA(IO("Q")))
Begin DoDot:1
+12 SET ZTRTN="STRPT^ECRDSSA"
SET ZTDESC="DSS UNIT ACTIVITY REPORT"
+13 SET (ZTSAVE("ECLOC("),ZTSAVE("ECDSSU("),ZTSAVE("ECSRT"))=""
+14 SET (ZTSAVE("ECSTDT"),ZTSAVE("ECENDDT"))=""
+15 DO ^%ZTLOAD
+16 DO HOME^%ZIS
+17 SET ECX=0
End DoDot:1
+18 QUIT ECX
