NURQEDT0 ;HIRMFO/MH,RM,YH-EDIT NURQ QI SUMMARY FILE, 217 ;1/22/97 15:30
;;4.0;NURSING SERVICE;;Apr 25, 1997
EN1 ; Entry from Important Functions [NURQA-PT-KEYFUNC] option.
Q:'$$SURGENVR^NURQUTL1(2,1)
D EDTCOMM(1)
I DA>0 D E1
D Q
Q
E1 ; Edit Important Functions Data
S DIE="^NURQ(217,"_DA(1)_",2,",DR="2" D ^DIE K DIE,DR
I $D(Y) S NURQOUT=1
Q
EN2 ; Entry from Receiver of Results [NURQA-PT-ROFR] option.
Q:'$$SURGENVR^NURQUTL1(2,1)
D EDTCOMM(0)
I DA>0 S DA(1)=DA D E2
D Q
Q
E2 ; Edit Receiver of Results
N X,NURQSDA S NURQSDA=DA(1)
S X=$P($G(^NURQ(217,DA(1),8,+$P($G(^NURQ(217,DA(1),8,0)),U,3),0)),U)
I X]"" S DIC("B")=X
ROR ; Come back here to edit a new receiver of results.
S DA(1)=NURQSDA,DLAYGO=217,DIC(0)="AEQL",DIC="^NURQ(217,"_DA(1)_",8,",DIC("P")="217.08" W ! D ^DIC K DIC
I +Y'>0 S NURQOUT=$S($D(DTOUT)!$D(DUOUT):1,1:0) Q
S DA=+Y,DIE="^NURQ(217,"_DA(1)_",8,",DR=".01;.02" D ^DIE
I $D(Y) S NURQOUT=1 Q
K DIE,DR G ROR
Q
EN3 ; Entry from Data [NURQA-PT-DATA] option.
Q:'$$SURGENVR^NURQUTL1(2,1)
D EDTCOMM(0)
I DA>0 D E3
D Q
Q
E3 ; Edit Data
S DR="5;7.1;6;7.2;7.3",DIE="^NURQ(217," D ^DIE K DIE,DR
I $D(Y) S NURQOUT=1
Q
EN4 ; Entry from Survey Generator [NURQA-PT-INDIC] option.
Q:'$$SURGENVR^NURQUTL1(2,1)
D EDTCOMM(1)
I DA>0 S DA(2)=DA(1),DA(1)=DA D RELIND^NURQEDT1
D Q
Q
EN5 ; Entry from Disciplines [NURQA-PT-RESP] option.
Q:'$$SURGENVR^NURQUTL1(2,1)
D EDTCOMM(0)
I DA>0 D E5
D Q
Q
E5 ; Edit Disciplines
S DR="3;2",DIE="^NURQ(217," D ^DIE K DIE,DR
I $D(Y) S NURQOUT=1
Q
EN7 ; Entry from References [NURQA-PT-REFR] option.
Q:'$$SURGENVR^NURQUTL1(2,1)
D EDTCOMM(0)
I DA>0 D E7
D Q
Q
E7 ; Edit References
S DR="9",DIE="^NURQ(217," D ^DIE K DIE,DR
I $D(Y) S NURQOUT=1
Q
EN8 ; Entry from Other QI Summary Data [NURQA-PT-OTHER] option.
Q:'$$SURGENVR^NURQUTL1(2,1)
D EDTCOMM(0)
I DA>0 D E8
D Q
Q
E8 ; Edit Other QI Summary Data
S DR="11",DIE="^NURQ(217," D ^DIE K DIE,DR
I $D(Y) S NURQOUT=1
Q
Q ; Clean up and exit
K DA,NURQOUT,NURQSDA,NSW
Q
EDTCOMM(NURQIP) ; Select Survey and Location and edit common fields.
; Input Parameters: NURQIP = 0 if just query for survey
; 1 if query for survey and location
; Output variables: NURQOUT = 0 initialize this variable
; Var. NURQIP Value of variable
; ---- ------ -----------------
; DA 0 IEN of 217, or -1 if failed
; 1 IEN of 217.04, or -1 if failed
; DA(1) 0 Not returned.
; 1 IEN of 217, or undefined if failed
;
K DA N NURQWRD,NURDICS,NURDFLT,NURSZLO,Y S NURQOUT=0
S DIC("A")="Select SURVEY: ",DIC=217,DIC(0)="AELMQ",DLAYGO=217
D ^DIC K DIC,DLAYGO
I +Y'>0 S DA=-1 Q
S DA=+Y,DIE="^NURQ(217,",DR="1///^S X=DUZ" D ^DIE K DIE,DR
I $D(Y) S DA=-1 Q
Q:'$G(NURQIP) S DA(1)=DA S DA=$$GETLOC(DA(1)) I DA<0 K DA(1)
Q
GETLOC(NURQSURV) ; This function will return a Location (217.04)
; multiple IEN.
; Input parameter: NURQSURV = NURQ QI Summary (217) file IEN.
;
N DA S NUROUT=0,DA(1)=NURQSURV
D GETDF I NUROUT K NUROUT Q -1
S DIC("S")=NURDICS S:NURDFLT'="" DIC("B")=NURDFLT
S DIC("A")="Select LOCATION: ",DIC(0)="AEMQ",DIC="^NURSF(211.4,"
W ! D ^DIC K DIC,NUROUT I +Y'>0 Q -1
S NURQWRD=$P(Y,U,2) I NURQWRD'>0 Q -1
S DA=$O(^NURQ(217,DA(1),2,"B",NURQWRD,0)) I DA>0 Q DA
S X=NURQWRD,DIC="^NURQ(217,"_DA(1)_",2,",DIC(0)="L",DLAYGO=217,DIC("P")="217.04P"
K DD,DO D FILE^DICN K DIC,DLAYGO S DA=+Y I DA'>0 S DA=-1
Q DA
GETDF ; This procedure will get the default location (if any) and the
; screen for a lookup on Nurs Location.
; Input Variable: DUZ = user doing lookup
; Output Variables: NURDICS = M code for screen on lookup.
; NURDFLT = Default location (text) or null if
; no default exists.
; NURSZLO( = array of locations set from NURSAUTL.
; NUROUT = 1 if security not proper, else 0.
;
N X
D EN1^NURSAUTL I NUROUT G QDF ; needs DUZ
S NURDICS="I $S('$D(^(""I"")):1,$P(^(""I""),U)=""A"":1,1:0)"_$S(NURSZAP>6:",$D(NURSZLO(Y))",1:""),NURDFLT=""
I NURSZAP>6,$D(NURSZLO) D
. 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
. Q
E S X=+$P($G(^NURQ(217,DA(1),2,0)),U,3),NURDFLT=+$G(^NURQ(217,DA(1),2,X,0))
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))
QDF ; Quit GETDF procedure and clean up variables
K NURSZFAC,NURSZDA,NURSZAP,NURSZSP,NURQ44 ; set by EN1^NURSAUTL
Q
NURQEDT0 ;HIRMFO/MH,RM,YH-EDIT NURQ QI SUMMARY FILE, 217 ;1/22/97 15:30
+1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
EN1 ; Entry from Important Functions [NURQA-PT-KEYFUNC] option.
+1 IF '$$SURGENVR^NURQUTL1(2,1)
QUIT
+2 DO EDTCOMM(1)
+3 IF DA>0
DO E1
+4 DO Q
+5 QUIT
E1 ; Edit Important Functions Data
+1 SET DIE="^NURQ(217,"_DA(1)_",2,"
SET DR="2"
DO ^DIE
KILL DIE,DR
+2 IF $DATA(Y)
SET NURQOUT=1
+3 QUIT
EN2 ; Entry from Receiver of Results [NURQA-PT-ROFR] option.
+1 IF '$$SURGENVR^NURQUTL1(2,1)
QUIT
+2 DO EDTCOMM(0)
+3 IF DA>0
SET DA(1)=DA
DO E2
+4 DO Q
+5 QUIT
E2 ; Edit Receiver of Results
+1 NEW X,NURQSDA
SET NURQSDA=DA(1)
+2 SET X=$PIECE($GET(^NURQ(217,DA(1),8,+$PIECE($GET(^NURQ(217,DA(1),8,0)),U,3),0)),U)
+3 IF X]""
SET DIC("B")=X
ROR ; Come back here to edit a new receiver of results.
+1 SET DA(1)=NURQSDA
SET DLAYGO=217
SET DIC(0)="AEQL"
SET DIC="^NURQ(217,"_DA(1)_",8,"
SET DIC("P")="217.08"
WRITE !
DO ^DIC
KILL DIC
+2 IF +Y'>0
SET NURQOUT=$SELECT($DATA(DTOUT)!$DATA(DUOUT):1,1:0)
QUIT
+3 SET DA=+Y
SET DIE="^NURQ(217,"_DA(1)_",8,"
SET DR=".01;.02"
DO ^DIE
+4 IF $DATA(Y)
SET NURQOUT=1
QUIT
+5 KILL DIE,DR
GOTO ROR
+6 QUIT
EN3 ; Entry from Data [NURQA-PT-DATA] option.
+1 IF '$$SURGENVR^NURQUTL1(2,1)
QUIT
+2 DO EDTCOMM(0)
+3 IF DA>0
DO E3
+4 DO Q
+5 QUIT
E3 ; Edit Data
+1 SET DR="5;7.1;6;7.2;7.3"
SET DIE="^NURQ(217,"
DO ^DIE
KILL DIE,DR
+2 IF $DATA(Y)
SET NURQOUT=1
+3 QUIT
EN4 ; Entry from Survey Generator [NURQA-PT-INDIC] option.
+1 IF '$$SURGENVR^NURQUTL1(2,1)
QUIT
+2 DO EDTCOMM(1)
+3 IF DA>0
SET DA(2)=DA(1)
SET DA(1)=DA
DO RELIND^NURQEDT1
+4 DO Q
+5 QUIT
EN5 ; Entry from Disciplines [NURQA-PT-RESP] option.
+1 IF '$$SURGENVR^NURQUTL1(2,1)
QUIT
+2 DO EDTCOMM(0)
+3 IF DA>0
DO E5
+4 DO Q
+5 QUIT
E5 ; Edit Disciplines
+1 SET DR="3;2"
SET DIE="^NURQ(217,"
DO ^DIE
KILL DIE,DR
+2 IF $DATA(Y)
SET NURQOUT=1
+3 QUIT
EN7 ; Entry from References [NURQA-PT-REFR] option.
+1 IF '$$SURGENVR^NURQUTL1(2,1)
QUIT
+2 DO EDTCOMM(0)
+3 IF DA>0
DO E7
+4 DO Q
+5 QUIT
E7 ; Edit References
+1 SET DR="9"
SET DIE="^NURQ(217,"
DO ^DIE
KILL DIE,DR
+2 IF $DATA(Y)
SET NURQOUT=1
+3 QUIT
EN8 ; Entry from Other QI Summary Data [NURQA-PT-OTHER] option.
+1 IF '$$SURGENVR^NURQUTL1(2,1)
QUIT
+2 DO EDTCOMM(0)
+3 IF DA>0
DO E8
+4 DO Q
+5 QUIT
E8 ; Edit Other QI Summary Data
+1 SET DR="11"
SET DIE="^NURQ(217,"
DO ^DIE
KILL DIE,DR
+2 IF $DATA(Y)
SET NURQOUT=1
+3 QUIT
Q ; Clean up and exit
+1 KILL DA,NURQOUT,NURQSDA,NSW
+2 QUIT
EDTCOMM(NURQIP) ; Select Survey and Location and edit common fields.
+1 ; Input Parameters: NURQIP = 0 if just query for survey
+2 ; 1 if query for survey and location
+3 ; Output variables: NURQOUT = 0 initialize this variable
+4 ; Var. NURQIP Value of variable
+5 ; ---- ------ -----------------
+6 ; DA 0 IEN of 217, or -1 if failed
+7 ; 1 IEN of 217.04, or -1 if failed
+8 ; DA(1) 0 Not returned.
+9 ; 1 IEN of 217, or undefined if failed
+10 ;
+11 KILL DA
NEW NURQWRD,NURDICS,NURDFLT,NURSZLO,Y
SET NURQOUT=0
+12 SET DIC("A")="Select SURVEY: "
SET DIC=217
SET DIC(0)="AELMQ"
SET DLAYGO=217
+13 DO ^DIC
KILL DIC,DLAYGO
+14 IF +Y'>0
SET DA=-1
QUIT
+15 SET DA=+Y
SET DIE="^NURQ(217,"
SET DR="1///^S X=DUZ"
DO ^DIE
KILL DIE,DR
+16 IF $DATA(Y)
SET DA=-1
QUIT
+17 IF '$GET(NURQIP)
QUIT
SET DA(1)=DA
SET DA=$$GETLOC(DA(1))
IF DA<0
KILL DA(1)
+18 QUIT
GETLOC(NURQSURV) ; This function will return a Location (217.04)
+1 ; multiple IEN.
+2 ; Input parameter: NURQSURV = NURQ QI Summary (217) file IEN.
+3 ;
+4 NEW DA
SET NUROUT=0
SET DA(1)=NURQSURV
+5 DO GETDF
IF NUROUT
KILL NUROUT
QUIT -1
+6 SET DIC("S")=NURDICS
IF NURDFLT'=""
SET DIC("B")=NURDFLT
+7 SET DIC("A")="Select LOCATION: "
SET DIC(0)="AEMQ"
SET DIC="^NURSF(211.4,"
+8 WRITE !
DO ^DIC
KILL DIC,NUROUT
IF +Y'>0
QUIT -1
+9 SET NURQWRD=$PIECE(Y,U,2)
IF NURQWRD'>0
QUIT -1
+10 SET DA=$ORDER(^NURQ(217,DA(1),2,"B",NURQWRD,0))
IF DA>0
QUIT DA
+11 SET X=NURQWRD
SET DIC="^NURQ(217,"_DA(1)_",2,"
SET DIC(0)="L"
SET DLAYGO=217
SET DIC("P")="217.04P"
+12 KILL DD,DO
DO FILE^DICN
KILL DIC,DLAYGO
SET DA=+Y
IF DA'>0
SET DA=-1
+13 QUIT DA
GETDF ; This procedure will get the default location (if any) and the
+1 ; screen for a lookup on Nurs Location.
+2 ; Input Variable: DUZ = user doing lookup
+3 ; Output Variables: NURDICS = M code for screen on lookup.
+4 ; NURDFLT = Default location (text) or null if
+5 ; no default exists.
+6 ; NURSZLO( = array of locations set from NURSAUTL.
+7 ; NUROUT = 1 if security not proper, else 0.
+8 ;
+9 NEW X
+10 ; needs DUZ
DO EN1^NURSAUTL
IF NUROUT
GOTO QDF
+11 SET NURDICS="I $S('$D(^(""I"")):1,$P(^(""I""),U)=""A"":1,1:0)"_$SELECT(NURSZAP>6:",$D(NURSZLO(Y))",1:"")
SET NURDFLT=""
+12 IF NURSZAP>6
IF $DATA(NURSZLO)
Begin DoDot:1
+13 SET X=0
FOR
SET X=$ORDER(NURSZLO(X))
IF X'>0
QUIT
SET NURQ44=$PIECE($GET(^NURSF(211.4,X,0)),U)
SET NURQ=$ORDER(^NURQ(217,DA(1),2,"B",NURQ44,0))
IF NURQ>0
SET NURDFLT=NURQ44
QUIT
+14 QUIT
End DoDot:1
+15 IF '$TEST
SET X=+$PIECE($GET(^NURQ(217,DA(1),2,0)),U,3)
SET NURDFLT=+$GET(^NURQ(217,DA(1),2,X,0))
+16 IF NURDFLT]""
SET X=$PIECE($GET(^SC(+NURDFLT,0)),U)
SET NURDFLT=$SELECT($PIECE(X,U)["NUR ":$PIECE($PIECE(X,U),"NUR ",2),1:$PIECE(X,U))
QDF ; Quit GETDF procedure and clean up variables
+1 ; set by EN1^NURSAUTL
KILL NURSZFAC,NURSZDA,NURSZAP,NURSZSP,NURQ44
+2 QUIT
