Changeset 623 for WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXDVSN1.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXDVSN1.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXDVSN1.m
r613 r623 1 ECXDVSN1 ;ALB/JAP - Division selection utility (cont.) ; 3/30/07 7:56am 2 ;;3.0;DSS EXTRACTS;**8,105**;Dec 22, 1997;Build 70 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,ARRAY 137 S:'$D(ECXALL) ECXALL=1 S:ECXALL="" ECXALL=1 138 S ECXERR=0,ECXP="",ARRAY="^TMP($J,""ECXDSS"")" 139 K @ARRAY 140 ;if ecxall=1, then all pharmacy sites are selected or there's only one 141 I ECXALL=1 S ECXP="" D 142 .D PSS^PSO59(,"??","ECXDSS") 143 .F S ECXP=$O(@ARRAY@("B",ECXP)) Q:ECXP="" S ECXIEN=$O(^(ECXP,0)) Q:'ECXIEN Q:'$D(^(ECXIEN)) D 144 ..S ECXDIV(ECXIEN)=ECXIEN_U_@ARRAY@(ECXIEN,.01)_U_^(.06)_U_^(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 ..N DIC,X,Y,DUOUT,DTOUT 149 ..S DIC="^PS(59,",DIC(0)="AEMQZ" 150 ..D DIC^PSODI(59,.DIC,.X) 151 ..I $G(DUOUT)!($G(DTOUT)) S OUT=1,ECXERR=1 Q 152 ..I Y=-1,X="" S OUT=1 Q 153 ..D PSS^PSO59(+Y,,"ECXDSS") 154 ..Q:'$D(@ARRAY) 155 ..S ECXDIV(ECXIEN)=ECXIEN_U_@ARRAY@(ECXIEN,.01)_U_^(.06)_U_^(100) 156 ; 157 I ECXERR=1 K ECXDIV 158 I '$D(ECXDIV) S ECXERR=1 159 Q 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
Note:
See TracChangeset
for help on using the changeset viewer.
