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

ECXDVSN1.m

Go to the documentation of this file.
  1. ECXDVSN1 ;ALB/JAP - Division selection utility (cont.) ; 3/30/07 7:56am
  1. ;;3.0;DSS EXTRACTS;**8,105**;Dec 22, 1997;Build 70
  1. ;
  1. ECQ(ECXDIV,ECXALL,ECXERR) ;setup division/site information for QSR extract audit report
  1. ; input
  1. ; ECXDIV = passed by reference array variable (required)
  1. ; ECXALL = 0/1 (optional)
  1. ; '0' indicates user to select QUASAR site/division;
  1. ; '1' indicates 'all' sites/divisions or only one site/division
  1. ; exists in file #509850.8; currently only one site is allowed
  1. ; to be defined;
  1. ; default is '1'
  1. ; output
  1. ; ECXDIV = data for QUASAR site/division;
  1. ; ECXDIV(ien in file #4)=ien in file #509850.8^name^station number
  1. ; ECXERR = 0/1
  1. ; if input problem, then '1' returned
  1. ;
  1. N X,Y,DIC,OUT,ECX,ECXD,ECXIEN
  1. S:'$D(ECXALL) ECXALL=1 S:ECXALL="" ECXALL=1
  1. ;currently, only ONE site may be defined in file #509850.8
  1. S:ECXALL=0 ECXALL=1
  1. S ECXERR=0,ECXD=""
  1. ;if ecxall=1, then all QUASAR sites/divisions; but there's only one
  1. I ECXALL=1 D
  1. .F S ECXD=$O(^ACK(509850.8,"B",ECXD)) Q:ECXD="" S ECXIEN=$O(^(ECXD,"")) D
  1. ..K ECX S DIC="^DIC(4,",DIQ(0)="I",DIQ="ECX",DA=ECXD,DR=".01;99" D EN^DIQ1
  1. ..I $D(ECX) S ECXDIV(ECXD)=ECXIEN_U_ECX(4,ECXD,.01,"I")_U_ECX(4,ECXD,99,"I")
  1. ..I '$D(ECX) S ECXERR=1
  1. I ECXERR=1 K ECXDIV
  1. I '$D(ECXDIV) S ECXERR=1
  1. Q
  1. ;
  1. LAB(ECXACC,ECXALL,ECXERR) ;setup accession area information for LAB extract audit report
  1. ; input
  1. ; ECXACC = passed by reference array variable (required)
  1. ; ECXALL = 0/1 (optional)
  1. ; '0' indicates user to select Accession Area(s);
  1. ; '1' indicates 'all' Accession Areas are selected
  1. ; default is '1'
  1. ; output
  1. ; ECXACC = data for Accession Area(s);
  1. ; ECXACC(ien in file #68)=name^abbreviation
  1. ; ECXERR = 0/1
  1. ; if input problem, then '1' returned
  1. ;
  1. N X,Y,DIC,DIQ,DA,DR,DTOUT,DUOUT,DIRUT,OUT,ECX,ECXA,ECXIEN
  1. S:'$D(ECXALL) ECXALL=1 S:ECXALL="" ECXALL=1
  1. S ECXERR=0,ECXA=""
  1. ;if ecxall=1, then all accession areas are selected
  1. I ECXALL=1 D
  1. .;^LRO(68,"B",xxx,ien)=1 indicates a synonym; skip synonyms
  1. .F S ECXA=$O(^LRO(68,"B",ECXA)) Q:ECXA="" S ECXIEN=$O(^(ECXA,"")) D
  1. ..Q:^LRO(68,"B",ECXA,ECXIEN)=1
  1. ..K ECX S DIC="^LRO(68,",DR=".01;.09",DIQ="ECX",DA=ECXIEN D EN^DIQ1
  1. ..Q:'$D(ECX)
  1. ..;acc. areas with ZZ in name indicates no longer used
  1. ..Q:$E(ECX(68,ECXIEN,.01),1,2)="ZZ"
  1. ..S ECXACC(ECXIEN)=ECX(68,ECXIEN,.01)_U_ECX(68,ECXIEN,.09)
  1. ;if ecxall=0, user selects some/all acc. areas
  1. ;allow user to choose "ZZ"'d acc. area even though it may currently be inactive
  1. I ECXALL=0 S OUT=0 D
  1. .F Q:OUT!ECXERR D
  1. ..S DIC="^LRO(68,",DIC(0)="AEMQZ" K X,Y D ^DIC
  1. ..I $G(DUOUT)!($G(DTOUT)) S OUT=1,ECXERR=1 Q
  1. ..I Y=-1,X="" S OUT=1 Q
  1. ..S ECXACC(+Y)=$P(Y(0),U,1)_U_$P(Y(0),U,11)
  1. I ECXERR=1 K ECXACC
  1. I '$D(ECXACC) S ECXERR=1
  1. Q
  1. ;
  1. NUR(ECXDIV,ECXALL,ECXERR) ;setup accession area information for LAB extract audit report
  1. ; input
  1. ; ECXDIV = passed by reference array variable (required)
  1. ; ECXALL = 0/1 (optional)
  1. ; '0' indicates user to select nursing location(s)/division(s);
  1. ; '1' indicates 'all' nursing locations and medical center divisions
  1. ; are selected or facility is non-divisional;
  1. ; default is '1'
  1. ; output
  1. ; ECXDIV = data for nursing location(s) and medical center division(s);
  1. ; ECXDIV("D",ien in file #40.8)=ien in file #4^name^station number
  1. ; ECXDIV(ien in file #211.4,ien in file #40.8)=ien in file #44
  1. ; ECXERR = 0/1
  1. ; if input problem, then '1' returned
  1. ;
  1. ;N X,Y,DIC,DIQ,DA,OUT,ECX,ECXLOC,ECXSC,ECXDIEN,ECXNLIEN,ECXNLNM,ECXPRIME
  1. S:'$D(ECXALL) ECXALL=1 S:ECXALL="" ECXALL=1
  1. S (ECXERR,OUT)=0,ECXSC=""
  1. ;get ien in file #40.8 of primary division
  1. S ECXPRIME=$$PRIM^VASITE(DT)
  1. ;associate nursing locations with medical center divisions
  1. F S ECXSC=$O(^NURSF(211.4,"B",ECXSC)) Q:ECXSC="" S ECXNLIEN="" F S ECXNLIEN=$O(^NURSF(211.4,"B",ECXSC,ECXNLIEN)) Q:ECXNLIEN="" D
  1. .K ECX
  1. .S ECXDIEN=0,ECXNLNM="",DIC="^SC(",DIQ(0)="I",DIQ="ECX",DA=ECXSC,DR=".01;3.5" D EN^DIQ1
  1. .;if the 15th piece is null or y=-1 then ecxdien=primary division as default
  1. .I $D(ECX) S ECXDIEN=+ECX(44,ECXSC,3.5,"I"),ECXNLNM=ECX(44,ECXSC,.01,"I")
  1. .S:ECXDIEN=0 ECXDIEN=ECXPRIME
  1. .S ECXLOC(ECXDIEN)="",ECXLOC(ECXDIEN,ECXNLIEN)=ECXSC_U_ECXNLNM
  1. ;
  1. ;if ecxall=1 don't prompt; setup all nursing locations and divisions incl. those w/o division
  1. I ECXALL=1 S ECXDIEN="" D
  1. .F S ECXDIEN=$O(ECXLOC(ECXDIEN)) Q:ECXDIEN="" D
  1. ..S DIC="^DG(40.8,",DIC(0)="NXZ",X=ECXDIEN D ^DIC I +Y>0 D
  1. ...S ECXDIV("D",ECXDIEN)=$P(Y(0),U,7)_U_$P(Y(0),U,1)_U_$P(Y(0),U,2),ECXNLIEN=""
  1. ...F S ECXNLIEN=$O(ECXLOC(ECXDIEN,ECXNLIEN)) Q:ECXNLIEN="" S ECXDIV(ECXNLIEN,ECXDIEN)=ECXLOC(ECXDIEN,ECXNLIEN)
  1. ;
  1. ;if ecxall=0 let user select division(s)
  1. I ECXALL=0 F Q:OUT!ECXERR D
  1. .S DIC="^DG(40.8,",DIC(0)="AEMQZ",DIC("S")="I $P(^(0),U,3)'=1"
  1. .D ^DIC I $G(DUOUT)!($G(DTOUT)) S OUT=1,ECXERR=1 Q
  1. .I Y=-1,X="" S OUT=1 Q
  1. .S ECXDIEN=+Y,NM=$P(Y,U,2)
  1. .I '$D(ECXLOC(ECXDIEN)) D Q
  1. ..W !!,?5,"Division "_NM_" not associated with Nursing Locations.",!,?5,"Try again...",!
  1. .S ECXDIV("D",ECXDIEN)=$P(Y(0),U,7)_U_$P(Y(0),U,1)_U_$P(Y(0),U,2),ECXNLIEN=""
  1. .F S ECXNLIEN=$O(ECXLOC(ECXDIEN,ECXNLIEN)) Q:ECXNLIEN="" S ECXDIV(ECXNLIEN,ECXDIEN)=ECXLOC(ECXDIEN,ECXNLIEN)
  1. ;in case of user up-arrow out or timeout, make sure nothing returned in ecxdiv
  1. I ECXERR=1 K ECXDIV
  1. I '$D(ECXDIV) S ECXERR=1
  1. Q
  1. ;
  1. PRE(ECXDIV,ECXALL,ECXERR) ;setup site information for PRE extract audit report
  1. ; input
  1. ; ECXDIV = passed by reference array variable (required)
  1. ; ECXALL = 0/1 (optional)
  1. ; '0' indicates user to select Pharmacy site(s);
  1. ; '1' indicates 'all' sites are selected
  1. ; default is '1'
  1. ; output
  1. ; ECXDIV = data for Pharmacy site(s);
  1. ; ECXDIV(ien in file #59)=IEN in file #59^name^site number^IEN in file #4
  1. ; ECXERR = 0/1
  1. ; if input problem, then '1' returned
  1. ;
  1. N X,Y,DIC,DIQ,DA,OUT,ECXARR,ECXP,ECXIEN,ARRAY
  1. S:'$D(ECXALL) ECXALL=1 S:ECXALL="" ECXALL=1
  1. S ECXERR=0,ECXP="",ARRAY="^TMP($J,""ECXDSS"")"
  1. K @ARRAY
  1. ;if ecxall=1, then all pharmacy sites are selected or there's only one
  1. I ECXALL=1 S ECXP="" D
  1. .D PSS^PSO59(,"??","ECXDSS")
  1. .F S ECXP=$O(@ARRAY@("B",ECXP)) Q:ECXP="" S ECXIEN=$O(^(ECXP,0)) Q:'ECXIEN Q:'$D(^(ECXIEN)) D
  1. ..S ECXDIV(ECXIEN)=ECXIEN_U_@ARRAY@(ECXIEN,.01)_U_^(.06)_U_^(100)
  1. ;if ecxall=0, then user selects pharmacy site(s)
  1. I ECXALL=0 S OUT=0 D
  1. .F Q:OUT!ECXERR D
  1. ..N DIC,X,Y,DUOUT,DTOUT
  1. ..S DIC="^PS(59,",DIC(0)="AEMQZ"
  1. ..D DIC^PSODI(59,.DIC,.X)
  1. ..I $G(DUOUT)!($G(DTOUT)) S OUT=1,ECXERR=1 Q
  1. ..I Y=-1,X="" S OUT=1 Q
  1. ..D PSS^PSO59(+Y,,"ECXDSS")
  1. ..Q:'$D(@ARRAY)
  1. ..S ECXDIV(ECXIEN)=ECXIEN_U_@ARRAY@(ECXIEN,.01)_U_^(.06)_U_^(100)
  1. ;
  1. I ECXERR=1 K ECXDIV
  1. I '$D(ECXDIV) S ECXERR=1
  1. Q