| 1 | ECXDVSN1 ;ALB/JAP - Division selection utility (cont.) ;Sep 30, 1997
|
|---|
| 2 | ;;3.0;DSS EXTRACTS;**8**;Dec 22, 1997
|
|---|
| 3 | ;
|
|---|
| 4 | ECQ(ECXDIV,ECXALL,ECXERR) ;setup division/site information for QSR extract audit report
|
|---|
| 5 | ; input
|
|---|
| 6 | ; ECXDIV = passed by reference array variable (required)
|
|---|
| 7 | ; ECXALL = 0/1 (optional)
|
|---|
| 8 | ; '0' indicates user to select QUASAR site/division;
|
|---|
| 9 | ; '1' indicates 'all' sites/divisions or only one site/division
|
|---|
| 10 | ; exists in file #509850.8; currently only one site is allowed
|
|---|
| 11 | ; to be defined;
|
|---|
| 12 | ; default is '1'
|
|---|
| 13 | ; output
|
|---|
| 14 | ; ECXDIV = data for QUASAR site/division;
|
|---|
| 15 | ; ECXDIV(ien in file #4)=ien in file #509850.8^name^station number
|
|---|
| 16 | ; ECXERR = 0/1
|
|---|
| 17 | ; if input problem, then '1' returned
|
|---|
| 18 | ;
|
|---|
| 19 | N X,Y,DIC,OUT,ECX,ECXD,ECXIEN
|
|---|
| 20 | S:'$D(ECXALL) ECXALL=1 S:ECXALL="" ECXALL=1
|
|---|
| 21 | ;currently, only ONE site may be defined in file #509850.8
|
|---|
| 22 | S:ECXALL=0 ECXALL=1
|
|---|
| 23 | S ECXERR=0,ECXD=""
|
|---|
| 24 | ;if ecxall=1, then all QUASAR sites/divisions; but there's only one
|
|---|
| 25 | I ECXALL=1 D
|
|---|
| 26 | .F S ECXD=$O(^ACK(509850.8,"B",ECXD)) Q:ECXD="" S ECXIEN=$O(^(ECXD,"")) D
|
|---|
| 27 | ..K ECX S DIC="^DIC(4,",DIQ(0)="I",DIQ="ECX",DA=ECXD,DR=".01;99" D EN^DIQ1
|
|---|
| 28 | ..I $D(ECX) S ECXDIV(ECXD)=ECXIEN_U_ECX(4,ECXD,.01,"I")_U_ECX(4,ECXD,99,"I")
|
|---|
| 29 | ..I '$D(ECX) S ECXERR=1
|
|---|
| 30 | I ECXERR=1 K ECXDIV
|
|---|
| 31 | I '$D(ECXDIV) S ECXERR=1
|
|---|
| 32 | Q
|
|---|
| 33 | ;
|
|---|
| 34 | LAB(ECXACC,ECXALL,ECXERR) ;setup accession area information for LAB extract audit report
|
|---|
| 35 | ; input
|
|---|
| 36 | ; ECXACC = passed by reference array variable (required)
|
|---|
| 37 | ; ECXALL = 0/1 (optional)
|
|---|
| 38 | ; '0' indicates user to select Accession Area(s);
|
|---|
| 39 | ; '1' indicates 'all' Accession Areas are selected
|
|---|
| 40 | ; default is '1'
|
|---|
| 41 | ; output
|
|---|
| 42 | ; ECXACC = data for Accession Area(s);
|
|---|
| 43 | ; ECXACC(ien in file #68)=name^abbreviation
|
|---|
| 44 | ; ECXERR = 0/1
|
|---|
| 45 | ; if input problem, then '1' returned
|
|---|
| 46 | ;
|
|---|
| 47 | N X,Y,DIC,DIQ,DA,DR,DTOUT,DUOUT,DIRUT,OUT,ECX,ECXA,ECXIEN
|
|---|
| 48 | S:'$D(ECXALL) ECXALL=1 S:ECXALL="" ECXALL=1
|
|---|
| 49 | S ECXERR=0,ECXA=""
|
|---|
| 50 | ;if ecxall=1, then all accession areas are selected
|
|---|
| 51 | I ECXALL=1 D
|
|---|
| 52 | .;^LRO(68,"B",xxx,ien)=1 indicates a synonym; skip synonyms
|
|---|
| 53 | .F S ECXA=$O(^LRO(68,"B",ECXA)) Q:ECXA="" S ECXIEN=$O(^(ECXA,"")) D
|
|---|
| 54 | ..Q:^LRO(68,"B",ECXA,ECXIEN)=1
|
|---|
| 55 | ..K ECX S DIC="^LRO(68,",DR=".01;.09",DIQ="ECX",DA=ECXIEN D EN^DIQ1
|
|---|
| 56 | ..Q:'$D(ECX)
|
|---|
| 57 | ..;acc. areas with ZZ in name indicates no longer used
|
|---|
| 58 | ..Q:$E(ECX(68,ECXIEN,.01),1,2)="ZZ"
|
|---|
| 59 | ..S ECXACC(ECXIEN)=ECX(68,ECXIEN,.01)_U_ECX(68,ECXIEN,.09)
|
|---|
| 60 | ;if ecxall=0, user selects some/all acc. areas
|
|---|
| 61 | ;allow user to choose "ZZ"'d acc. area even though it may currently be inactive
|
|---|
| 62 | I ECXALL=0 S OUT=0 D
|
|---|
| 63 | .F Q:OUT!ECXERR D
|
|---|
| 64 | ..S DIC="^LRO(68,",DIC(0)="AEMQZ" K X,Y D ^DIC
|
|---|
| 65 | ..I $G(DUOUT)!($G(DTOUT)) S OUT=1,ECXERR=1 Q
|
|---|
| 66 | ..I Y=-1,X="" S OUT=1 Q
|
|---|
| 67 | ..S ECXACC(+Y)=$P(Y(0),U,1)_U_$P(Y(0),U,11)
|
|---|
| 68 | I ECXERR=1 K ECXACC
|
|---|
| 69 | I '$D(ECXACC) S ECXERR=1
|
|---|
| 70 | Q
|
|---|
| 71 | ;
|
|---|
| 72 | NUR(ECXDIV,ECXALL,ECXERR) ;setup accession area information for LAB extract audit report
|
|---|
| 73 | ; input
|
|---|
| 74 | ; ECXDIV = passed by reference array variable (required)
|
|---|
| 75 | ; ECXALL = 0/1 (optional)
|
|---|
| 76 | ; '0' indicates user to select nursing location(s)/division(s);
|
|---|
| 77 | ; '1' indicates 'all' nursing locations and medical center divisions
|
|---|
| 78 | ; are selected or facility is non-divisional;
|
|---|
| 79 | ; default is '1'
|
|---|
| 80 | ; output
|
|---|
| 81 | ; ECXDIV = data for nursing location(s) and medical center division(s);
|
|---|
| 82 | ; ECXDIV("D",ien in file #40.8)=ien in file #4^name^station number
|
|---|
| 83 | ; ECXDIV(ien in file #211.4,ien in file #40.8)=ien in file #44
|
|---|
| 84 | ; ECXERR = 0/1
|
|---|
| 85 | ; if input problem, then '1' returned
|
|---|
| 86 | ;
|
|---|
| 87 | ;N X,Y,DIC,DIQ,DA,OUT,ECX,ECXLOC,ECXSC,ECXDIEN,ECXNLIEN,ECXNLNM,ECXPRIME
|
|---|
| 88 | S:'$D(ECXALL) ECXALL=1 S:ECXALL="" ECXALL=1
|
|---|
| 89 | S (ECXERR,OUT)=0,ECXSC=""
|
|---|
| 90 | ;get ien in file #40.8 of primary division
|
|---|
| 91 | S ECXPRIME=$$PRIM^VASITE(DT)
|
|---|
| 92 | ;associate nursing locations with medical center divisions
|
|---|
| 93 | 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
|
|---|
| 94 | .K ECX
|
|---|
| 95 | .S ECXDIEN=0,ECXNLNM="",DIC="^SC(",DIQ(0)="I",DIQ="ECX",DA=ECXSC,DR=".01;3.5" D EN^DIQ1
|
|---|
| 96 | .;if the 15th piece is null or y=-1 then ecxdien=primary division as default
|
|---|
| 97 | .I $D(ECX) S ECXDIEN=+ECX(44,ECXSC,3.5,"I"),ECXNLNM=ECX(44,ECXSC,.01,"I")
|
|---|
| 98 | .S:ECXDIEN=0 ECXDIEN=ECXPRIME
|
|---|
| 99 | .S ECXLOC(ECXDIEN)="",ECXLOC(ECXDIEN,ECXNLIEN)=ECXSC_U_ECXNLNM
|
|---|
| 100 | ;
|
|---|
| 101 | ;if ecxall=1 don't prompt; setup all nursing locations and divisions incl. those w/o division
|
|---|
| 102 | I ECXALL=1 S ECXDIEN="" D
|
|---|
| 103 | .F S ECXDIEN=$O(ECXLOC(ECXDIEN)) Q:ECXDIEN="" D
|
|---|
| 104 | ..S DIC="^DG(40.8,",DIC(0)="NXZ",X=ECXDIEN D ^DIC I +Y>0 D
|
|---|
| 105 | ...S ECXDIV("D",ECXDIEN)=$P(Y(0),U,7)_U_$P(Y(0),U,1)_U_$P(Y(0),U,2),ECXNLIEN=""
|
|---|
| 106 | ...F S ECXNLIEN=$O(ECXLOC(ECXDIEN,ECXNLIEN)) Q:ECXNLIEN="" S ECXDIV(ECXNLIEN,ECXDIEN)=ECXLOC(ECXDIEN,ECXNLIEN)
|
|---|
| 107 | ;
|
|---|
| 108 | ;if ecxall=0 let user select division(s)
|
|---|
| 109 | I ECXALL=0 F Q:OUT!ECXERR D
|
|---|
| 110 | .S DIC="^DG(40.8,",DIC(0)="AEMQZ",DIC("S")="I $P(^(0),U,3)'=1"
|
|---|
| 111 | .D ^DIC I $G(DUOUT)!($G(DTOUT)) S OUT=1,ECXERR=1 Q
|
|---|
| 112 | .I Y=-1,X="" S OUT=1 Q
|
|---|
| 113 | .S ECXDIEN=+Y,NM=$P(Y,U,2)
|
|---|
| 114 | .I '$D(ECXLOC(ECXDIEN)) D Q
|
|---|
| 115 | ..W !!,?5,"Division "_NM_" not associated with Nursing Locations.",!,?5,"Try again...",!
|
|---|
| 116 | .S ECXDIV("D",ECXDIEN)=$P(Y(0),U,7)_U_$P(Y(0),U,1)_U_$P(Y(0),U,2),ECXNLIEN=""
|
|---|
| 117 | .F S ECXNLIEN=$O(ECXLOC(ECXDIEN,ECXNLIEN)) Q:ECXNLIEN="" S ECXDIV(ECXNLIEN,ECXDIEN)=ECXLOC(ECXDIEN,ECXNLIEN)
|
|---|
| 118 | ;in case of user up-arrow out or timeout, make sure nothing returned in ecxdiv
|
|---|
| 119 | I ECXERR=1 K ECXDIV
|
|---|
| 120 | I '$D(ECXDIV) S ECXERR=1
|
|---|
| 121 | Q
|
|---|
| 122 | ;
|
|---|
| 123 | PRE(ECXDIV,ECXALL,ECXERR) ;setup site information for PRE extract audit report
|
|---|
| 124 | ; input
|
|---|
| 125 | ; ECXDIV = passed by reference array variable (required)
|
|---|
| 126 | ; ECXALL = 0/1 (optional)
|
|---|
| 127 | ; '0' indicates user to select Pharmacy site(s);
|
|---|
| 128 | ; '1' indicates 'all' sites are selected
|
|---|
| 129 | ; default is '1'
|
|---|
| 130 | ; output
|
|---|
| 131 | ; ECXDIV = data for Pharmacy site(s);
|
|---|
| 132 | ; ECXDIV(ien in file #59)=IEN in file #59^name^site number^IEN in file #4
|
|---|
| 133 | ; ECXERR = 0/1
|
|---|
| 134 | ; if input problem, then '1' returned
|
|---|
| 135 | ;
|
|---|
| 136 | N X,Y,DIC,DIQ,DA,OUT,ECXARR,ECXP,ECXIEN
|
|---|
| 137 | S:'$D(ECXALL) ECXALL=1 S:ECXALL="" ECXALL=1
|
|---|
| 138 | S ECXERR=0,ECXP=""
|
|---|
| 139 | ;if ecxall=1, then all pharmacy sites are selected or there's only one
|
|---|
| 140 | I ECXALL=1 S ECXP="" D
|
|---|
| 141 | .F S ECXP=$O(^PS(59,"B",ECXP)) Q:ECXP="" S ECXIEN=$O(^(ECXP,"")) D
|
|---|
| 142 | ..K ECXARR S DIC="^PS(59,",DR=".01;.06;100",DIQ="ECXARR",DA=ECXIEN D EN^DIQ1
|
|---|
| 143 | ..Q:'$D(ECXARR)
|
|---|
| 144 | ..S ECXDIV(ECXIEN)=ECXIEN_U_ECXARR(59,ECXIEN,.01)_U_ECXARR(59,ECXIEN,.06)_U_ECXARR(59,ECXIEN,100)
|
|---|
| 145 | ;if ecxall=0, then user selects pharmacy site(s)
|
|---|
| 146 | I ECXALL=0 S OUT=0 D
|
|---|
| 147 | .F Q:OUT!ECXERR D
|
|---|
| 148 | ..S DIC="^PS(59,",DIC(0)="AEMQZ" K X,Y D ^DIC
|
|---|
| 149 | ..I $G(DUOUT)!($G(DTOUT)) S OUT=1,ECXERR=1 Q
|
|---|
| 150 | ..I Y=-1,X="" S OUT=1 Q
|
|---|
| 151 | ..K ECXARR S (ECXIEN,DA)=+Y,DIC="^PS(59,",DR=".01;.06;100",DIQ="ECXARR" D EN^DIQ1
|
|---|
| 152 | ..Q:'$D(ECXARR)
|
|---|
| 153 | ..S ECXDIV(ECXIEN)=ECXIEN_U_ECXARR(59,ECXIEN,.01)_U_ECXARR(59,ECXIEN,.06)_U_ECXARR(59,ECXIEN,100)
|
|---|
| 154 | ;
|
|---|
| 155 | I ECXERR=1 K ECXDIV
|
|---|
| 156 | I '$D(ECXDIV) S ECXERR=1
|
|---|
| 157 | Q
|
|---|
