- NURSAWCK ;HIRMFO/RM-CHECK SO EVERY MAS WARD HAS A NURSING LOCATION ;AUGUST 1986
- ;;4.0;NURSING SERVICE;;Apr 25, 1997
- EN1 ; CALLED BY ROUTINE NURSCPL & NURSCPLU, RETURNS NURSBAD (1 if MAS Ward has no
- ; Nursing equivalent, 0 if it does.), and BADWARD("MAS Ward") for
- ; the ward in question.
- 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 BADWARD(X)=""
- Q
- BADWARD ; ERROR MESSAGE IF THERE IS AN INVALID WARD
- W $C(7),!!!,"The following MAS Wards do not have corresponding NURSING Locations: "
- S NURSWR42="" F NURSZ=0:0 S NURSWR42=$O(BADWARD(NURSWR42)) Q:NURSWR42="" W !,?20,NURSWR42
- K NURSWR42,NURSZ
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURSAWCK 809 printed Feb 18, 2025@23:48:05 Page 2
- NURSAWCK ;HIRMFO/RM-CHECK SO EVERY MAS WARD HAS A NURSING LOCATION ;AUGUST 1986
- +1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
- EN1 ; CALLED BY ROUTINE NURSCPL & NURSCPLU, RETURNS NURSBAD (1 if MAS Ward has no
- +1 ; Nursing equivalent, 0 if it does.), and BADWARD("MAS Ward") for
- +2 ; the ward in question.
- +3 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
- +4 KILL NURSX,NURSZLOC
- IF NURSBAD
- SET BADWARD(X)=""
- +5 QUIT
- BADWARD ; ERROR MESSAGE IF THERE IS AN INVALID WARD
- +1 WRITE $CHAR(7),!!!,"The following MAS Wards do not have corresponding NURSING Locations: "
- +2 SET NURSWR42=""
- FOR NURSZ=0:0
- SET NURSWR42=$ORDER(BADWARD(NURSWR42))
- if NURSWR42=""
- QUIT
- WRITE !,?20,NURSWR42
- +3 KILL NURSWR42,NURSZ
- +4 QUIT