source: FOIAVistA/trunk/r/NURSING_SERVICE-NUR/NURQEDT0.m@ 1203

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

initial load of FOIAVistA 6/30/08 version
File size: 4.5 KB
Line 
1NURQEDT0 ;HIRMFO/MH,RM,YH-EDIT NURQ QI SUMMARY FILE, 217 ;1/22/97 15:30
2 ;;4.0;NURSING SERVICE;;Apr 25, 1997
3EN1 ; Entry from Important Functions [NURQA-PT-KEYFUNC] option.
4 Q:'$$SURGENVR^NURQUTL1(2,1)
5 D EDTCOMM(1)
6 I DA>0 D E1
7 D Q
8 Q
9E1 ; Edit Important Functions Data
10 S DIE="^NURQ(217,"_DA(1)_",2,",DR="2" D ^DIE K DIE,DR
11 I $D(Y) S NURQOUT=1
12 Q
13EN2 ; Entry from Receiver of Results [NURQA-PT-ROFR] option.
14 Q:'$$SURGENVR^NURQUTL1(2,1)
15 D EDTCOMM(0)
16 I DA>0 S DA(1)=DA D E2
17 D Q
18 Q
19E2 ; Edit Receiver of Results
20 N X,NURQSDA S NURQSDA=DA(1)
21 S X=$P($G(^NURQ(217,DA(1),8,+$P($G(^NURQ(217,DA(1),8,0)),U,3),0)),U)
22 I X]"" S DIC("B")=X
23ROR ; Come back here to edit a new receiver of results.
24 S DA(1)=NURQSDA,DLAYGO=217,DIC(0)="AEQL",DIC="^NURQ(217,"_DA(1)_",8,",DIC("P")="217.08" W ! D ^DIC K DIC
25 I +Y'>0 S NURQOUT=$S($D(DTOUT)!$D(DUOUT):1,1:0) Q
26 S DA=+Y,DIE="^NURQ(217,"_DA(1)_",8,",DR=".01;.02" D ^DIE
27 I $D(Y) S NURQOUT=1 Q
28 K DIE,DR G ROR
29 Q
30EN3 ; Entry from Data [NURQA-PT-DATA] option.
31 Q:'$$SURGENVR^NURQUTL1(2,1)
32 D EDTCOMM(0)
33 I DA>0 D E3
34 D Q
35 Q
36E3 ; Edit Data
37 S DR="5;7.1;6;7.2;7.3",DIE="^NURQ(217," D ^DIE K DIE,DR
38 I $D(Y) S NURQOUT=1
39 Q
40EN4 ; Entry from Survey Generator [NURQA-PT-INDIC] option.
41 Q:'$$SURGENVR^NURQUTL1(2,1)
42 D EDTCOMM(1)
43 I DA>0 S DA(2)=DA(1),DA(1)=DA D RELIND^NURQEDT1
44 D Q
45 Q
46EN5 ; Entry from Disciplines [NURQA-PT-RESP] option.
47 Q:'$$SURGENVR^NURQUTL1(2,1)
48 D EDTCOMM(0)
49 I DA>0 D E5
50 D Q
51 Q
52E5 ; Edit Disciplines
53 S DR="3;2",DIE="^NURQ(217," D ^DIE K DIE,DR
54 I $D(Y) S NURQOUT=1
55 Q
56EN7 ; Entry from References [NURQA-PT-REFR] option.
57 Q:'$$SURGENVR^NURQUTL1(2,1)
58 D EDTCOMM(0)
59 I DA>0 D E7
60 D Q
61 Q
62E7 ; Edit References
63 S DR="9",DIE="^NURQ(217," D ^DIE K DIE,DR
64 I $D(Y) S NURQOUT=1
65 Q
66EN8 ; Entry from Other QI Summary Data [NURQA-PT-OTHER] option.
67 Q:'$$SURGENVR^NURQUTL1(2,1)
68 D EDTCOMM(0)
69 I DA>0 D E8
70 D Q
71 Q
72E8 ; Edit Other QI Summary Data
73 S DR="11",DIE="^NURQ(217," D ^DIE K DIE,DR
74 I $D(Y) S NURQOUT=1
75 Q
76Q ; Clean up and exit
77 K DA,NURQOUT,NURQSDA,NSW
78 Q
79EDTCOMM(NURQIP) ; Select Survey and Location and edit common fields.
80 ; Input Parameters: NURQIP = 0 if just query for survey
81 ; 1 if query for survey and location
82 ; Output variables: NURQOUT = 0 initialize this variable
83 ; Var. NURQIP Value of variable
84 ; ---- ------ -----------------
85 ; DA 0 IEN of 217, or -1 if failed
86 ; 1 IEN of 217.04, or -1 if failed
87 ; DA(1) 0 Not returned.
88 ; 1 IEN of 217, or undefined if failed
89 ;
90 K DA N NURQWRD,NURDICS,NURDFLT,NURSZLO,Y S NURQOUT=0
91 S DIC("A")="Select SURVEY: ",DIC=217,DIC(0)="AELMQ",DLAYGO=217
92 D ^DIC K DIC,DLAYGO
93 I +Y'>0 S DA=-1 Q
94 S DA=+Y,DIE="^NURQ(217,",DR="1///^S X=DUZ" D ^DIE K DIE,DR
95 I $D(Y) S DA=-1 Q
96 Q:'$G(NURQIP) S DA(1)=DA S DA=$$GETLOC(DA(1)) I DA<0 K DA(1)
97 Q
98GETLOC(NURQSURV) ; This function will return a Location (217.04)
99 ; multiple IEN.
100 ; Input parameter: NURQSURV = NURQ QI Summary (217) file IEN.
101 ;
102 N DA S NUROUT=0,DA(1)=NURQSURV
103 D GETDF I NUROUT K NUROUT Q -1
104 S DIC("S")=NURDICS S:NURDFLT'="" DIC("B")=NURDFLT
105 S DIC("A")="Select LOCATION: ",DIC(0)="AEMQ",DIC="^NURSF(211.4,"
106 W ! D ^DIC K DIC,NUROUT I +Y'>0 Q -1
107 S NURQWRD=$P(Y,U,2) I NURQWRD'>0 Q -1
108 S DA=$O(^NURQ(217,DA(1),2,"B",NURQWRD,0)) I DA>0 Q DA
109 S X=NURQWRD,DIC="^NURQ(217,"_DA(1)_",2,",DIC(0)="L",DLAYGO=217,DIC("P")="217.04P"
110 K DD,DO D FILE^DICN K DIC,DLAYGO S DA=+Y I DA'>0 S DA=-1
111 Q DA
112GETDF ; This procedure will get the default location (if any) and the
113 ; screen for a lookup on Nurs Location.
114 ; Input Variable: DUZ = user doing lookup
115 ; Output Variables: NURDICS = M code for screen on lookup.
116 ; NURDFLT = Default location (text) or null if
117 ; no default exists.
118 ; NURSZLO( = array of locations set from NURSAUTL.
119 ; NUROUT = 1 if security not proper, else 0.
120 ;
121 N X
122 D EN1^NURSAUTL I NUROUT G QDF ; needs DUZ
123 S NURDICS="I $S('$D(^(""I"")):1,$P(^(""I""),U)=""A"":1,1:0)"_$S(NURSZAP>6:",$D(NURSZLO(Y))",1:""),NURDFLT=""
124 I NURSZAP>6,$D(NURSZLO) D
125 . S X=0 F S X=$O(NURSZLO(X)) Q:X'>0 S NURQ44=$P($G(^NURSF(211.4,X,0)),U),NURQ=$O(^NURQ(217,DA(1),2,"B",NURQ44,0)) I NURQ>0 S NURDFLT=NURQ44 Q
126 . Q
127 E S X=+$P($G(^NURQ(217,DA(1),2,0)),U,3),NURDFLT=+$G(^NURQ(217,DA(1),2,X,0))
128 I NURDFLT]"" S X=$P($G(^SC(+NURDFLT,0)),U),NURDFLT=$S($P(X,U)["NUR ":$P($P(X,U),"NUR ",2),1:$P(X,U))
129QDF ; Quit GETDF procedure and clean up variables
130 K NURSZFAC,NURSZDA,NURSZAP,NURSZSP,NURQ44 ; set by EN1^NURSAUTL
131 Q
Note: See TracBrowser for help on using the repository browser.