- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURQEDT0 4784 printed Feb 18, 2025@23:47:32 Page 2
- 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