NURAAU5 ;HIRMFO/FT-Check if every MAS Ward has a Nursing Location ;1/7/97 11:41
;;4.0;NURSING SERVICE;;Apr 25, 1997
;
EN1 ; called from NURAAU0 - the Nursing Acuity option
; sends a mail message to G.NURS-ADP group if MAS Ward does not have
; a corresponding Nursing Location.
K NURSTEXT
S NURSTEXT(1)="The following MAS Wards do not have corresponding NURSING Locations."
S NURSTEXT(2)="Use the 'Nursing Location File, Edit' option to correct this problem."
S NURSTEXT(3)=" "
S NURSLINE=3
F NURSY=0:0 S NURSY=$O(^DIC(42,NURSY)) Q:NURSY'>0 S X=$P(^DIC(42,NURSY,0),"^",1) D MATCHUP
I NURSLINE>3 D MAIL
K NURSBAD,NURSLINE,NURSTEXT,NURSX,NURSY,NURSZLOC
K X,XMDUZ,XMSUB,XMTEXT,XMY
Q
MATCHUP ; matchup MAS Wards and Nursing Locations
S NURSX=$O(^DIC(42,"B",X,"")),NURSBAD=1 I NURSX'="" F NURSZLOC=0:0 S NURSZLOC=$O(^NURSF(211.4,"C",NURSX,NURSZLOC)) Q:NURSZLOC'>0 I $S('$D(^NURSF(211.4,NURSZLOC,"I")):1,$P(^("I"),"^")="A":1,1:0) S NURSBAD=0
K NURSX,NURSZLOC
I NURSBAD S NURSLINE=NURSLINE+1,NURSTEXT(NURSLINE)=X
Q
MAIL ; send a mail message listing MAS Wards without Nursing Locations to
; Nursing mail group
S XMY("G.NURS-ADP")=""
S XMDUZ=.5
S XMTEXT="NURSTEXT("
S XMSUB="MAS Wards with no Nursing Locations"
S XMDUN="Nursing Acuity Option"
D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURAAU5 1303 printed Nov 22, 2024@17:28:56 Page 2
NURAAU5 ;HIRMFO/FT-Check if every MAS Ward has a Nursing Location ;1/7/97 11:41
+1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
+2 ;
EN1 ; called from NURAAU0 - the Nursing Acuity option
+1 ; sends a mail message to G.NURS-ADP group if MAS Ward does not have
+2 ; a corresponding Nursing Location.
+3 KILL NURSTEXT
+4 SET NURSTEXT(1)="The following MAS Wards do not have corresponding NURSING Locations."
+5 SET NURSTEXT(2)="Use the 'Nursing Location File, Edit' option to correct this problem."
+6 SET NURSTEXT(3)=" "
+7 SET NURSLINE=3
+8 FOR NURSY=0:0
SET NURSY=$ORDER(^DIC(42,NURSY))
if NURSY'>0
QUIT
SET X=$PIECE(^DIC(42,NURSY,0),"^",1)
DO MATCHUP
+9 IF NURSLINE>3
DO MAIL
+10 KILL NURSBAD,NURSLINE,NURSTEXT,NURSX,NURSY,NURSZLOC
+11 KILL X,XMDUZ,XMSUB,XMTEXT,XMY
+12 QUIT
MATCHUP ; matchup MAS Wards and Nursing Locations
+1 SET NURSX=$ORDER(^DIC(42,"B",X,""))
SET NURSBAD=1
IF NURSX'=""
FOR NURSZLOC=0:0
SET NURSZLOC=$ORDER(^NURSF(211.4,"C",NURSX,NURSZLOC))
if NURSZLOC'>0
QUIT
IF $SELECT('$DATA(^NURSF(211.4,NURSZLOC,"I")):1,$PIECE(^("I"),"^")="A":1,1:0)
SET NURSBAD=0
+2 KILL NURSX,NURSZLOC
+3 IF NURSBAD
SET NURSLINE=NURSLINE+1
SET NURSTEXT(NURSLINE)=X
+4 QUIT
MAIL ; send a mail message listing MAS Wards without Nursing Locations to
+1 ; Nursing mail group
+2 SET XMY("G.NURS-ADP")=""
+3 SET XMDUZ=.5
+4 SET XMTEXT="NURSTEXT("
+5 SET XMSUB="MAS Wards with no Nursing Locations"
+6 SET XMDUN="Nursing Acuity Option"
+7 DO ^XMD
+8 QUIT
