source: FOIAVistA/trunk/r/EVENT_CAPTURE-EC--ECT--ECX/ECMFDSSU.m@ 1397

Last change on this file since 1397 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 6.2 KB
Line 
1ECMFDSSU ;ALB/JAM-Event Capture Management Filer DSS Unit ;20 Nov 00
2 ;;2.0; EVENT CAPTURE ;**25,30,33**;8 May 96
3 ;
4FILE ;Used by the RPC broker to file DSS Units in file #724
5 ; Variables passed in
6 ; ECIEN - IEN of #724, if editing
7 ; ECDUNM - DSS Unit Name
8 ; ECS - Service
9 ; ECM - Medical Speciality
10 ; ECTR - Cost Center
11 ; ECUN - Unit Number
12 ; ECST - Status Flag (Active/Inactive)
13 ; ECASC - Associated Stop Code
14 ; ECC - Category
15 ; ECDFDT - Default Data Entry Date
16 ; ECPCE - Send to PCE
17 ; ECSCN - Event Code Screens status
18 ;
19 ; Variable return
20 ; ^TMP($J,"ECMSG",n)=Success or failure to file in #724^Message
21 ;
22 N ECERR,ECX,ECFLG,ECRES,ECONAM
23 S ECERR=0 D CHKDT I ECERR Q
24 D VALDATA I ECERR Q
25 S ECIEN=$G(ECIEN),ECFLG=1,ECONAM="",ECC=$S(ECC="Y":1,1:0)
26 I ECIEN'="" S ECFLG=0 D I ECERR D END Q
27 . I '$D(^ECD(ECIEN,0)) D Q
28 . . S ECERR=1,^TMP($J,"ECMSG",1)="0^DSS Unit Not on File" Q
29 . D CATCHK^ECUMRPC1(.ECRES,ECIEN) I ECRES,ECC'=$P(^ECD(ECIEN,0),U,11) D
30 . . S ECERR=1,^TMP($J,"ECMSG",1)="0^Category Changed, EC Screen exist"
31 . S ECONAM=$P($G(^ECD(ECIEN,0)),U)
32 D I ECERR D END Q ;Check name
33 . I (ECFLG)!((ECONAM'="")&(ECONAM'=ECDUNM)),$D(^ECD("B",ECDUNM)) D Q
34 . . S ECERR=1,^TMP($J,"ECMSG",1)="0^DSS Unit Name already exist"
35 . I 'ECFLG K DIE S DIE="^ECD(",DA=ECIEN,DR=".01////"_ECDUNM D ^DIE
36 S ECPCE=$S(ECPCE="A":"A",ECPCE="O":"O",1:"N")
37 I ECPCE="N",$G(ECASC)="" D D END Q
38 . S ECERR=1,^TMP($J,"ECMSG",1)="0^No associated clinic, Send to PCE=N"
39 I ECIEN="" D NEWIEN
40 K DA,DR,DIE
41 S ECST=$E($G(ECST)),ECST=$S(ECST="I":1,1:0),ECDFDT=$E($G(ECDFDT))
42 S ECDFDT=$S(ECDFDT="N":"N",1:"X"),DIE="^ECD(",DA=ECIEN
43 S DR="1////"_ECS_";2////"_ECM_";3////"_ECTR_";4////"_$G(ECUN)
44 S DR=DR_";5////"_ECST_";7////1;9////"_$S(ECPCE'="N":"@",1:$G(ECASC))
45 S DR=DR_";10////"_ECC_";11////"_ECDFDT_";13////"_ECPCE
46 D ^DIE I $D(DTOUT) D RECDEL D D END Q
47 . S ^TMP($J,"ECMSG",1)="0^DSS Unit Record not Filed"
48 I 'ECFLG D ECSCRNS
49 S ^TMP($J,"ECMSG",1)="1^DSS Unit Record Filed"_U_ECIEN
50END K DIE,DIC,DR,DA,DO,ECIEN
51 Q
52VALDATA ;validate data
53 N ECRRX
54 D CHK^DIE(724,.01,"E",ECDUNM,.ECRRX) I ECRRX'=ECDUNM D Q
55 .S ECERR=1,^TMP($J,"ECMSG",1)="0^Invalid DSS Unit Name"
56 D CHK^DIE(724,1,"E","`"_ECS,.ECRRX) I ECRRX'=ECS D Q
57 .S ECERR=1,^TMP($J,"ECMSG",1)="0^Invalid Service"
58 D CHK^DIE(724,2,"E","`"_ECM,.ECRRX) I ECRRX'=ECM D Q
59 .S ECERR=1,^TMP($J,"ECMSG",1)="0^Invalid Medical Speciality"
60 D CHK^DIE(724,3,"E","`"_ECTR,.ECRRX) I ECRRX'=ECTR D Q
61 .S ECERR=1,^TMP($J,"ECMSG",1)="0^Invalid Cost Center"
62 I $G(ECUN)'="" D CHK^DIE(724,4,"E",ECUN,.ECRRX) I ECRRX'=ECUN D Q
63 .S ECERR=1,^TMP($J,"ECMSG",1)="0^Invalid Unit Number"
64 I $G(ECASC)'="" D CHK^DIE(724,9,"E","`"_ECASC,.ECRRX) I ECRRX'=ECASC D Q
65 .S ECERR=1,^TMP($J,"ECMSG",1)="0^Invalid Associated Clinic"
66 Q
67ECSCRNS ;Determine if event codes should be updated based on change of DSS Unit
68 ;status
69 ; DSS Unit status changed from Active to Inactive, if EC screen status
70 ; A - retain, do nothing, B - inactiviate
71 ; DSS Unit status changed from Inactive to Active, if EC screen status
72 ; C - reactiviate, D - remain inactive
73 ;
74 N ECD,ECINC,ZTDESC,ZTSAVE,ZTIO,ZTRTN,ZTDTH
75 I ($G(ECSCN)="")!(ECSCN="A")!(ECSCN="D") Q
76 I "^B^C^"']"^"_ECSCN_"^" Q
77 S ECD=ECIEN,ECINC=DT
78 I ECSCN="B" D
79 .S ZTDESC="DEALLOCATE DSS UNIT & INACTIVATE EVENT CODE SCREENS"
80 I ECSCN="C" D
81 .S ZTDESC="REACTIVIATE EVENT CODE SCREENS",ECINC="@"
82 S ZTRTN=$S(ECSCN="B":"DIK",1:"INSCRN")_"^ECDEAL",ZTDTH=$H
83 N ECSCN
84 S ECSCN=1,(ZTSAVE("ECD"),ZTSAVE("ECSCN"),ZTSAVE("ECINC"))="",ZTIO=""
85 D ^%ZTLOAD K ZTSK Q
86 D @ZTRTN
87 Q
88 ;
89RECDEL ; Delete record
90 I ECFLG S DA=ECIEN,DIK="^ECD(" D ^DIK K DA,DIK
91 Q
92NEWIEN ;Create new IEN in file #724
93 N DIC,DA,DD,DO
94 L +^ECD(0)
95 S DIC=724,DIC(0)="L",X=ECDUNM
96 D FILE^DICN
97 L -^ECD(0)
98 S ECIEN=+Y
99 Q
100CHKDT ;Required Data Check
101 N I,C
102 S C=1
103 F I="ECDUNM","ECS","ECM","ECTR","ECC" D
104 .I $G(@I)="" S ^TMP($J,"ECMSG",C)="0^Key data missing "_I,C=C+1,ECERR=1
105 Q
106USER ;Used by the RPC broker to allocate or de-allocate users for DSS Units
107 ;in file #200
108 ; Variables passed in
109 ; ECIEN - IEN of DSS Unit in file #724
110 ; ECUSR0..n - Users to allocate/deallocate to DSS Unit
111 ;
112 ; Variable return
113 ; ^TMP($J,"ECMSG",n)=Success or failure to file in #724^Message
114 ;
115 N EDUZ,ECERR,ECI,ECX,USER,DIC,DIK,X,Y,DA
116 S (EDUZ,ECERR)=0,ECIEN=$G(ECIEN)
117 I ECIEN="" S ^TMP($J,"ECMSG",1)="0^DSS Unit missing" Q
118 D I ECERR Q
119 . I '$D(^ECD(ECIEN,0)) D
120 . . S ECERR=1,^TMP($J,"ECMSG",1)="0^DSS Unit Not on File"
121 F ECI=0:1 S ECX="ECUSR"_ECI Q:'$D(@ECX) S:@ECX'="" USER(@ECX)=""
122 F S EDUZ=$O(^VA(200,EDUZ)) Q:'EDUZ I $D(^VA(200,EDUZ,"EC",ECIEN,0)) D
123 . I $D(USER(EDUZ)) K USER(EDUZ) Q
124 . K DA,DIK S DA(1)=EDUZ,DA=ECIEN,DIK="^VA(200,"_DA(1)_",""EC"","
125 . D ^DIK K USER(EDUZ)
126 ;add users for DSS Unit
127 S EDUZ=0 F S EDUZ=$O(USER(EDUZ)) Q:'EDUZ D
128 . K DIC,DD,DO S DIC=200,DIC(0)="QNMX",X=EDUZ D ^DIC I Y<0 Q
129 . K DIC,DD,DO S DIC(0)="L",DA(1)=EDUZ,DIC("P")=$P(^DD(200,720,0),U,2)
130 . S DINUM=ECIEN,DIC="^VA(200,"_DA(1)_",""EC"",",X=ECIEN
131 . D FILE^DICN
132 S ^TMP($J,"ECMSG",1)="1^Record Filed"_U_ECIEN K DINUM
133 Q
134DSSU ;Used by the RPC broker to allocate or de-allocate DSS Units for a user
135 ;in file #200
136 ; Variables passed in
137 ; ECIEN - User IEN in file #200
138 ; ECD0..n - IEN of DSS Unit in file #724 to allocate/deallocate
139 ;
140 ;
141 ; Variable return
142 ; ^TMP($J,"ECMSG",n)=Success or failure to file in #200^Message
143 ;
144 N EDU,ECERR,ECI,ECX,ECDSSU,DIC,DIK,DA,X,Y
145 S (EDU,ECERR)=0,ECIEN=$G(ECIEN)
146 I ECIEN="" S ^TMP($J,"ECMSG",1)="0^User missing" Q
147 D I ECERR Q
148 . S DIC=200,DIC(0)="QNX",X=ECIEN D ^DIC D:Y<0
149 . . S ECERR=1,^TMP($J,"ECMSG",1)="0^User Not on File"
150 F ECI=0:1 S ECX="ECD"_ECI Q:'$D(@ECX) S:@ECX'="" ECDSSU(@ECX)=""
151 F S EDU=$O(^VA(200,ECIEN,"EC",EDU)) Q:'EDU D
152 . I $D(ECDSSU(EDU)) K ECDSSU(EDU) Q
153 . K DA,DIK S DA(1)=ECIEN,DA=EDU,DIK="^VA(200,"_DA(1)_",""EC"","
154 . D ^DIK
155 ;add DSS Units for user
156 S EDU=0 F S EDU=$O(ECDSSU(EDU)) Q:'EDU D
157 . I '$D(^ECD(EDU,0)) Q
158 . K DIC,DD,DO S DIC(0)="L",DA(1)=ECIEN,DIC("P")=$P(^DD(200,720,0),U,2)
159 . S DINUM=EDU,DIC="^VA(200,"_DA(1)_",""EC"",",X=EDU
160 . D FILE^DICN
161 S ^TMP($J,"ECMSG",1)="1^Record Filed"_U_ECIEN
162 Q
Note: See TracBrowser for help on using the repository browser.