Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ECRDSSA

ECRDSSA.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1. EN ;Get location(s), DSS Unit(s), sort type, start & end dates, device
  1.  ;
  1.  N ECLOC,ECDSSU,ECSORT,ECSTDT,ECENDDT ;112
  1.  I '$$ASKLOC^ECRUTL G ENQ
  1.  I '$$ASKDSS^ECRUTL G ENQ
  1.  I '$$ASKSRT(.ECSORT) G ENQ
  1.  I '$$STDT^ECRUTL G ENQ
  1.  I '$$ENDDT^ECRUTL(ECSTDT) G ENQ
  1.  I $$ASKDEV D STRPT^ECRDSSA
  1. ENQ Q
  1.  ;
  1. STRPT ;Main entry point
  1.  N ECCRT  ;is CRT?
  1.  N ECPAGE  ;page cnt
  1.  S ECPAGE=0
  1.  S ECCRT=$S($E(IOST,1,2)="C-":1,1:0)
  1.  I $G(ECPTYP)'="E" U IO ;119 open device if not exporting
  1.  K ^TMP("ECRPT",$J)
  1.  D FNDREC(ECSORT)
  1.  D PRINT(ECSORT)
  1.  K ^TMP("ECRPT",$J) D ^ECKILL ;119
  1.  Q
  1.  ;
  1. FNDREC(ECSRT) ;Loop through "ADT" xref of EVENT CAPTURE PATIENT (#721) file
  1.  ;  Input:
  1.  ;    ECSRT - sort type
  1.  ;
  1.  ;  Output: none
  1.  ;
  1.  N ECNT   ;record cnt
  1.  N ECL     ;location cnt
  1.  N ECD     ;DSS unit cnt
  1.  N ECDFN   ;DFN
  1.  N ECLOCF  ;Location IEN
  1.  N ECDSSF  ;DSS unit IEN
  1.  N ECDT    ;date index
  1.  N ECREC   ;"0" node
  1.  N ECIEN   ;IEN of file 721 ;patch 119
  1.  S ECNT=0
  1.  ;
  1.  S ECL=0
  1.  F  S ECL=$O(ECLOC(ECL)) Q:'ECL  S ECLOCF=+$P(ECLOC(ECL),U) D
  1.  . S ^TMP("ECRPT",$J,ECLOCF)=0  ;initialize location counter
  1.  . S ECD=0
  1.  . F  S ECD=$O(ECDSSU(ECD)) Q:'ECD  S ECDSSF=+$P(ECDSSU(ECD),U) D
  1.  . . S ^TMP("ECRPT",$J,ECLOCF,ECDSSF)=0  ;initialize DSS Unit counter
  1.  . S ECDFN=0
  1.  . F  S ECDFN=+$O(^ECH("ADT",ECLOCF,ECDFN)) Q:'ECDFN  D
  1.  . . S ECD=0
  1.  . . F  S ECD=$O(ECDSSU(ECD)) Q:'ECD  S ECDSSF=+$P(ECDSSU(ECD),U) D
  1.  . . . S ECDT=ECSTDT
  1.  . . . F  S ECDT=+$O(^ECH("ADT",ECLOCF,ECDFN,ECDSSF,ECDT)) Q:'ECDT!(ECDT>ECENDDT)  D
  1.  . . . . S ECIEN=0
  1.  . . . . F  S ECIEN=+$O(^ECH("ADT",ECLOCF,ECDFN,ECDSSF,ECDT,ECIEN)) Q:'ECIEN  D
  1.  . . . . . I $P($G(^ECH(ECIEN,0)),U,7)=ECDSSF D BLDTMP(ECIEN,ECSRT,.ECNT)
  1.  Q
  1.  ;
  1. BLDTMP(ECIEN,ECSRT,ECCNT) ;add record to list
  1.  ;  Input:
  1.  ;    ECIEN - pointer to EVENT CAPTURE PATIENT (#721) file
  1.  ;    ECSRT - sort type
  1.  ;    ECCNT - record counter
  1.  ;
  1.  ;  Output:
  1.  ;    ^TMP("ECRPT",$J,location,DSS unit,sort key1,sort key2,count)
  1.  ;
  1.  N ECLOCA  ;location
  1.  N ECDSS  ;DSS unit
  1.  N ECIENS  ;IENS
  1.  N ECKEY  ;sort key array
  1.  N ECREC  ;record string
  1.  N ECERR  ;FM error
  1.  N ECDT  ;date
  1.  N CLNODE ;Clinic zero node from 728.44
  1.  N ECACLN ;Clinic name
  1.  I +$G(ECIEN)>0,$$GETKEYS(ECSRT,ECIEN,.ECKEY) D
  1.  . S ECCNT=+$G(ECCNT)+1
  1.  . S ECIENS=ECIEN_","
  1.  . S ECREC=""
  1.  . 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)
  1.  . S ECACLN=$G(ECREC(721,ECIENS,26,"E")) ;134
  1.  . S CLNODE=$G(^ECX(728.44,+$G(ECREC(721,ECIENS,26,"I")),0)) ;134
  1.  . S ECLOCA=+$G(ECREC(721,ECIENS,3,"I"))
  1.  . S ECDSS=+$G(ECREC(721,ECIENS,6,"I"))
  1.  . S ECREC=ECREC_$E($G(ECREC(721,ECIENS,1,"E")),1,30)_"^"  ;pt name
  1.  . S ECREC=ECREC_$E($$GETSSN(ECIEN),1,10)_"^"              ;ssn
  1.  . S ECREC=ECREC_$E($G(ECREC(721,ECIENS,29,"I")),1)_"^"    ;in/out
  1.  . S ECREC=ECREC_$E($G(ECREC(721,ECIENS,2,"I")),1,13)_"^"  ;dt/tm
  1.  . S ECDT=$P($G(ECREC(721,ECIENS,2,"I")),".",1)
  1.  . S ECREC=ECREC_$E($$GETPROC($G(ECREC(721,ECIENS,8,"I"))),1,5)_"^"   ;proc code
  1.  . S ECREC=ECREC_$$GETPRNM($G(ECREC(721,ECIENS,8,"I")),ECDT)_"^"  ;126, get full proc name
  1.  . S ECREC=ECREC_$$GETPSYN(ECLOCA,ECDSS,+$G(ECREC(721,ECIENS,7,"I")),$G(ECREC(721,ECIENS,8,"I")))_"^" ;126 Get procedure synonym
  1.  . S ECREC=ECREC_$E($G(ECREC(721,ECIENS,9,"I")),1,2)_"^"   ;vol
  1.  . S ECREC=ECREC_$E($$GETPROV(ECIEN),1,30)_"^"  ;provider
  1.  . S ECREC=ECREC_$E($G(ECREC(721,ECIENS,20,"E")),1,8)_U      ;dx 131, allow more space,134 add trailing ^
  1.  . 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
  1.  . S ^TMP("ECRPT",$J,ECLOCA,ECDSS,ECKEY(1),ECKEY(2),ECNT)=ECREC
  1.  . S ^TMP("ECRPT",$J,ECLOCA)=$G(^TMP("ECRPT",$J,ECLOCA))+1
  1.  . S ^TMP("ECRPT",$J,ECLOCA,ECDSS)=$G(^TMP("ECRPT",$J,ECLOCA,ECDSS))+1
  1.  Q
  1.  ;
  1. PRINT(ECSRT) ;loop results array and format output
  1.  ;  Input:
  1.  ;    ECSRT - sort type
  1.  ;
  1.  ;  Output: none
  1.  ;
  1.  N ECCLOC  ;current location
  1.  N ECPLOC  ;previous location
  1.  N ECLOCNM  ;location name
  1.  N ECCDSS  ;current DSS unit
  1.  N ECPDSS  ;previous DSS unit
  1.  N ECDSSNM  ;DSS unit name
  1.  N ECCNT   ;record count
  1.  N ECDAT   ;procedure date/time
  1.  N ECRDT   ;run date
  1.  N ECFDT   ;from date
  1.  N ECTDT   ;to date
  1.  N ECKEY1  ;sort key 1
  1.  N ECKEY2  ;sort key 2
  1.  N ECSRTBY  ;sort type text
  1.  N ECQUIT  ;user quit indicator
  1.  N ECREC   ;tmp record data
  1.  N CNT,PIECE ;119 array count for data, record piece
  1.  I $G(ECPTYP)="E" D  ;134
  1.  .S ^TMP($J,"ECRPT",1)="LOCATION^DSS UNIT (IEN #)^PATIENT^SSN^I/O^DATE/TIME^CLINIC^STOP CODE^CREDIT STOP^CHAR4" ;119,126,134
  1.  .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
  1.  I '$D(^TMP("ECRPT",$J)) G PRINTQ
  1.  S ECRDT=$$FMTE^XLFDT($$NOW^XLFDT,"5DZ")
  1.  S ECFDT=$$FMTE^XLFDT($P(ECSTDT+.0001,"."),"5DZ")
  1.  S ECTDT=$$FMTE^XLFDT($P(ECENDDT,"."),"5DZ")
  1.  S ECSRTBY=$S(ECSRT="P":"Patient Name",ECSRT="R":"Provider Name",ECSRT="S":"Patient SSN",1:"")
  1.  S (ECCLOC,ECPLOC,ECQUIT)=0
  1.  F  S ECCLOC=$O(^TMP("ECRPT",$J,ECCLOC)) Q:'ECCLOC!(ECQUIT)  D
  1.  . I ECCLOC'=ECPLOC D  ;location changed
  1.  . . S ECPLOC=ECCLOC
  1.  . . S ECLOCNM=$$GETLOCN(ECCLOC,.ECLOC)
  1.  . . 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
  1.  . I $G(ECPTYP)'="E" I $G(^TMP("ECRPT",$J,ECCLOC))=0 D  Q  ;119
  1.  . . W !!,"    ** No records found on Location that match selection criteria"
  1.  . S (ECCDSS,ECPDSS)=0
  1.  . F  S ECCDSS=$O(^TMP("ECRPT",$J,ECCLOC,ECCDSS)) Q:'ECCDSS!(ECQUIT)  D
  1.  . . I ECCDSS'=ECPDSS D  Q:ECQUIT  ;dss unit changed
  1.  . . . S ECPDSS=ECCDSS
  1.  . . . S ECDSSNM=$$GETDSSN(ECCDSS,.ECDSSU)
  1.  . . . I $G(ECPTYP)'="E" I $Y>(IOSL-10) D PAUSE Q:ECQUIT  D HDR(ECLOCNM,ECRDT,ECFDT,ECTDT,ECSRTBY) ;119
  1.  . . . I $G(ECPTYP)'="E" D DSSHDR(ECCDSS,ECDSSNM) ;119
  1.  . . I $G(ECPTYP)'="E" I $G(^TMP("ECRPT",$J,ECCLOC,ECCDSS))=0 D  Q  ;119
  1.  . . . W !,"** No records found on DSS Unit that match selection criteria"
  1.  . . S ECKEY1=""
  1.  . . F  S ECKEY1=$O(^TMP("ECRPT",$J,ECCLOC,ECCDSS,ECKEY1)) Q:ECKEY1=""!(ECQUIT)  D
  1.  . . . S ECKEY2=""
  1.  . . . F  S ECKEY2=$O(^TMP("ECRPT",$J,ECCLOC,ECCDSS,ECKEY1,ECKEY2)) Q:ECKEY2=""!(ECQUIT)  D
  1.  . . . . S ECCNT=0
  1.  . . . . F  S ECCNT=$O(^TMP("ECRPT",$J,ECCLOC,ECCDSS,ECKEY1,ECKEY2,ECCNT)) Q:'ECCNT!(ECQUIT)  D
  1.  . . . . . 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
  1.  . . . . . S ECREC=^TMP("ECRPT",$J,ECCLOC,ECCDSS,ECKEY1,ECKEY2,ECCNT)
  1.  . . . . . I $G(ECPTYP)="E" S CNT=CNT+1 S ^TMP($J,"ECRPT",CNT)=ECLOCNM_U_ECDSSNM_"(IEN #"_ECCDSS_")" D  Q  ;119
  1.  . . . . . . 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
  1.  . . . . . W !,$P(ECREC,U,1)  ;name
  1.  . . . . . W ?27,$P(ECREC,U,2)  ;126 ssn
  1.  . . . . . W ?36,$P(ECREC,U,3)  ;126 inpt/outpt
  1.  . . . . . S ECDAT=$$FMTE^XLFDT($P(ECREC,U,4),"2MZ")
  1.  . . . . . W ?40,$P(ECDAT,":")_$P(ECDAT,":",2)  ;126 dt/tm
  1.  . . . . . W ?54,$P(ECREC,U,5)  ;126 proc code
  1.  . . . . . W ?60,$P(ECREC,U,6)  ;126 proc name
  1.  . . . . . W ?112,$P(ECREC,U,8)  ;119,126 vol
  1.  . . . . . W ?118,$P(ECREC,U,10)  ;126 dx
  1.  . . . . . W !,?36,$P(ECREC,U,11) ;134 Clinic
  1.  . . . . . W ?68,$P(ECREC,U,12) ;134 Stop Code
  1.  . . . . . W ?74,$P(ECREC,U,13) ;134 Credit Stop Code
  1.  . . . . . W ?82,$P(ECREC,U,14) ;134 CHAR4 code
  1.  . . . . . W !?4,$P(ECREC,U,9) ;126 Provider
  1.  . . . . . W ?60,$P(ECREC,U,7) ;126 Synonym
  1.  I $G(ECPTYP)'="E" I 'ECQUIT D PAUSE ;119
  1. PRINTQ Q
  1.  ;
  1. HDR(ECLOCN,ECRDT,ECFDT,ECTDT,ECSRT) ;Report header
  1.  ;  Input:
  1.  ;    ECLOCN - location name
  1.  ;    ECRDT - run date
  1.  ;    EDFDT - from date
  1.  ;    EDTDT - to date
  1.  ;    ECSRT - sort text
  1.  ;
  1.  ;  Output:  none
  1.  ;
  1.  I ECCRT!(ECPAGE) W @IOF
  1.  S ECPAGE=ECPAGE+1
  1.  W !,?11,"EVENT CAPTURE DSS UNIT ACTIVITY REPORT"
  1.  W ?58,"Run Date: ",ECRDT
  1.  W ?109,"Page: ",ECPAGE
  1.  W !!,?13,"For Location ",ECLOCN
  1.  W !,?13,"From "_ECFDT_" through "_ECTDT
  1.  W !,?13,"Sorted by ",ECSRT
  1.  W !!,"Patient",?27,"SSN",?36,"I/O",?40,"Date/Time",?54,"Procedure",?112,"Vol",?118,"Primary" ;126
  1.  W !?54,"Code",?60,"Name",?118,"Diagnosis" ;126
  1.  W !,?36,"CLINIC",?68,"STOP",?74,"CREDIT",?82,"CHAR4" ;134
  1.  W !?4,"Primary Provider",?60,"Synonym",!,$$REPEAT^XLFSTR("-",132) ;126
  1.  Q
  1.  ;
  1. DSSHDR(ECDSS,ECDSSNM) ;DSS header
  1.  ;  Input:
  1.  ;    ECDSS - DSS unit
  1.  ;    ECDSSNM - DSS unit name
  1.  ;
  1.  ;  Output:  none
  1.  ;
  1.  W !!,"DSS Unit: ",ECDSSNM," (IEN #",ECDSS,")"
  1.  Q
  1.  ;
  1. PAUSE ;page break
  1.  N DIR,DIRUT,DUOUT
  1.  D FOOTER
  1.  Q:'ECCRT
  1.  I IOSL<30 F  W ! Q:$Y>(IOSL-7)
  1.  W !
  1.  S DIR(0)="E"
  1.  D ^DIR
  1.  I $D(DIRUT)!($D(DUOUT)) S ECQUIT=1
  1.  Q
  1.  ;
  1.  W !!?4,"Volume totals may represent days, minutes, numbers of procedures"
  1.  W " and/or a combination of these.",! ;149,134
  1.  Q
  1.  ;
  1. GETLOCN(ECLOCA,ECLOC) ;get location name
  1.  ;  Input:
  1.  ;    ECLOCA - location
  1.  ;    ECLOC - array of selected locations
  1.  ;
  1.  ;  Output:
  1.  ;   Function value - returns location name on success; "" on failure
  1.  ;
  1.  N ECI
  1.  N ECLOCNM
  1.  S ECLOCNM=""
  1.  I +$G(ECLOCA)>0 D
  1.  . S ECI=0
  1.  . F  S ECI=$O(ECLOC(ECI)) Q:'ECI!(ECLOCNM'="")  D
  1.  . . I $P(ECLOC(ECI),U)=ECLOCA S ECLOCNM=$P(ECLOC(ECI),U,2)
  1.  Q ECLOCNM
  1.  ;
  1. GETDSSN(ECDSS,ECDSSU) ;-get DSS unit name
  1.  ;  Input:
  1.  ;    ECDSS - DSS unit
  1.  ;    ECDSSU - array of selected DSS units
  1.  ;
  1.  ;  Output:
  1.  ;   Function value - returns DSS unit name on success; "" on failure
  1.  ;
  1.  N ECI
  1.  N ECDSSNM
  1.  S ECDSSNM=""
  1.  I +$G(ECDSS)>0 D
  1.  . S ECI=0
  1.  . F  S ECI=$O(ECDSSU(ECI)) Q:'ECI!(ECDSSNM'="")  D
  1.  . . I $P(ECDSSU(ECI),U)=ECDSS S ECDSSNM=$P(ECDSSU(ECI),U,2)
  1.  Q ECDSSNM
  1.  ;
  1. GETKEYS(ECSRT,ECIEN,ECKEYS) ;get sort keys based on sort type
  1.  ;  Input:
  1.  ;    ECSRT - (required) sort type indicator (P, S, R)
  1.  ;    ECIEN - (required) pointer to EVENT CAPTURE PATIENT (#721) file
  1.  ;    
  1.  ;  Output:
  1.  ;    ECKEYS - (pass by reference) array of sort keys
  1.  ;    Function value - returns 1 on success;0 on failure
  1.  ;
  1.  N ECRSLT  ;function value
  1.  S ECRSLT=0
  1.  S (ECKEYS(1),ECKEYS(2))=""
  1.  I $G(ECSRT)'="",+$G(ECIEN)>0 D
  1.  . I ECSRT="P" D
  1.  . . S ECKEYS(1)=$$GET1^DIQ(721,ECIEN_",",1)  ;name
  1.  . . S ECKEYS(2)=$E($$GETSSN(ECIEN),1,9)  ;ssn
  1.  . I ECSRT="R" D
  1.  . . S ECKEYS(1)=$$GETPROV(ECIEN)  ;provider
  1.  . . I ECKEYS(1)="" S ECKEYS(1)=" "  ;missing provider sorts to top
  1.  . . S ECKEYS(2)=$$GET1^DIQ(721,ECIEN_",",1)  ;name
  1.  . I ECSRT="S" D
  1.  . . S ECKEYS(1)=$E($$GETSSN(ECIEN),1,9)  ;ssn
  1.  . . S ECKEYS(2)=$$GET1^DIQ(721,ECIEN_",",1)  ;name
  1.  . I ECKEYS(1)'="",ECKEYS(2)'="" S ECRSLT=1
  1.  Q ECRSLT
  1.  ;
  1. GETSSN(ECIEN) ;get patient SSN
  1.  ;  Input:
  1.  ;    ECIEN - (required) pointer to EVENT CAPTURE PATIENT (#721) file
  1.  ;    
  1.  ;  Output:
  1.  ;    Function value - returns patient's SSN on success; "" on failure
  1.  ;
  1.  N DFN,VADM,VAERR  ;VADPT variables
  1.  I +$G(ECIEN)>0 D
  1.  . S DFN=$$GET1^DIQ(721,ECIEN_",",1,"I")
  1.  . D DEM^VADPT
  1.  I $G(ECPTYP)="E" Q $P($G(VADM(2)),U)  ;119 full SSN on export
  1.  Q $E($P($G(VADM(2)),U),6,9)  ;112, only get last 4 SSN
  1.  ;
  1. GETPROV(ECIEN) ;get primary provider
  1.  ;This function retrieves the primary provider for a given Event
  1.  ;Capture record.  Searches the PROVIDER MULTIPLE (#42) field first
  1.  ;and falls back to the PROVIDER (#10) field.
  1.  ;  Input:
  1.  ;    ECIEN -(required) pointer to EVENT CAPTURE PATIENT (#721) file
  1.  ;
  1.  ;  Output:
  1.  ;   Function value - returns provider's name on success; "" on failure
  1.  ;
  1.  N ECPROV  ;provider name
  1.  S ECPROV=""
  1.  I $G(ECIEN)'="",$D(^ECH(ECIEN)) D
  1.  . ;try PROVIDER MULTIPLE
  1.  . I '$$GETPPRV^ECPRVMUT(ECIEN,.ECPROV) D  ;api returns "0" on success
  1.  . . S ECPROV=$P(ECPROV,U,2)
  1.  . E  D  ;try PROVIDER
  1.  . . S ECPROV=$$GET1^DIQ(721,ECIEN_",",10)
  1.  Q ECPROV
  1.  ;
  1. GETPRNM(ECVIEN,ECDT) ;get procedure name
  1.  ;  Input:
  1.  ;    ECVIEN - variable pointer to CPT (#81) file or EC PROC file
  1.  ;    
  1.  ;  Output:
  1.  ;    Function value - returns procedure name on success; "" on failure
  1.  ;
  1.  N ECIEN   ;IEN part of variable pointer
  1.  N ECFILE  ;file part of variable pointer
  1.  S ECIEN=$P(ECVIEN,";",1)
  1.  S ECFILE=$P(ECVIEN,";",2)
  1.  Q $S(ECFILE["ICPT(":$P($$CPT^ICPTCOD(ECIEN,ECDT),U,3),ECFILE["EC(725":$$GET1^DIQ(725,ECIEN_",",.01),1:"")
  1.  ;
  1. GETPROC(ECVIEN) ;get procedure code
  1.  ;  Input:
  1.  ;    ECVIEN - variable pointer to CPT (#81) file or EC PROC file
  1.  ;
  1.  ;  Output:
  1.  ;   Function value - returns procedure code on success; "" on failure
  1.  ;
  1.  N ECIEN  ;IEN part of variable pointer
  1.  N ECFILE  ;file part of variable pointer
  1.  S ECIEN=$P(ECVIEN,";",1)
  1.  S ECFILE=$P(ECVIEN,";",2)
  1.  Q $S(ECFILE["ICPT(":$$GET1^DIQ(81,ECIEN_",",.01),ECFILE["EC(725":$$GET1^DIQ(725,ECIEN_",",1),1:"")
  1.  ;
  1. GETPSYN(LOC,UNIT,CAT,PROC) ;API added in 126, gets synonym for EC screen
  1.  N SYN,IEN
  1.  S SYN=""
  1.  I PROC="" Q SYN
  1.  S IEN=$O(^ECJ("AP",LOC,UNIT,CAT,PROC,0))
  1.  I IEN="" Q SYN
  1.  Q $P($G(^ECJ(IEN,"PRO")),U,2)
  1.  ;
  1. ASKSRT(ECTYP) ;Ask report sort type
  1.  ;  Input:  none
  1.  ;  
  1.  ;  Output:
  1.  ;    ECTYP - (pass by reference) Sort type
  1.  ;            (P: Patient Name,S: SSN,R: Provider Name)
  1.  ;    Function value - returns 1 on success; 0 on failure
  1.  ;
  1.  N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y  ;^DIR variables
  1.  S DIR(0)="SA^P:PATIENT NAME;S:SSN;R:PROVIDER NAME"
  1.  S DIR("A")="Sort within each DSS Unit by: "
  1.  S DIR("B")="SSN"
  1.  D ^DIR
  1.  S ECTYP=$P(Y,U)
  1.  Q $S($D(DUOUT):0,$D(DTOUT):0,$D(DIROUT):0,1:1)
  1.  ;
  1. ASKDEV() ;Ask output device
  1.  ;  Input:  none
  1.  ;
  1.  ; Output:  1 if report is printed
  1.  ;          0 if report is queued (or exited)
  1.  ;
  1.  N ECX,ZTDESC,ZTRTN,ZTSAVE
  1.  S ECX=1
  1.  K %ZIS S %ZIS="QMP"
  1.  D ^%ZIS
  1.  S:POP ECX=0
  1.  I ECX&($D(IO("Q"))) D
  1.  . S ZTRTN="STRPT^ECRDSSA",ZTDESC="DSS UNIT ACTIVITY REPORT"
  1.  . S (ZTSAVE("ECLOC("),ZTSAVE("ECDSSU("),ZTSAVE("ECSRT"))=""
  1.  . S (ZTSAVE("ECSTDT"),ZTSAVE("ECENDDT"))=""
  1.  . D ^%ZTLOAD
  1.  . D HOME^%ZIS
  1.  . S ECX=0
  1.  Q ECX