Routine: NURCAS2

NURCAS2 ;HIRMFO/MD,FT-UTILITY($J) ARRAY BUILDER FOR ASSIGNMENT SHEET ;6/26/97  14:42

 ;;4.0;NURSING SERVICE;**2,24**;Apr 25, 1997

 I "Pp"[NUREDB D PAT

 I "Uu"[NUREDB D KVAR^VADPT F DFN=0:0 S DFN=$O(^NURSF(214,"AF","A",NURWARD,DFN)) Q:DFN'>0  W:$E(IOST)="C" "." D 1^VADPT D ALLPAT

 I "Ss"[NUREDB F DFN=0:0 S DFN=$O(^NURSF(214,"AF","A",NURWARD,DFN)) Q:DFN'>0  D 1^VADPT W:$E(IOST)="C" "." I VADM(1)'="" D SELECT

SELECT S NROOM="" F  S NROOM=$O(NRMBD(NROOM)) Q:NROOM=""  I $P($P(VAIN(5),U),"-",1,2)=NROOM D SELECT1

SELECT1 S NBED=$S('($P(VAIN(5),"-",2)=""):$P(VAIN(5),"-",2),1:"  BLANK"),NAME=$P(VADM(1),"^"),^TMP($J,"NURCEN",NROOM,NBED,NAME)=DFN_"^"_VA("PID")_"^"_$P(VAIN(7),"^",2)

ALLPAT I '(VADM(1)="") S NAME=VADM(1),NROOM=$S('($P(VAIN(5),"-")=""):$P(VAIN(5),"-"),1:"  BLANK"),NBED=$S('($P(VAIN(5),"-",2)=""):$P(VAIN(5),"-",2),1:"  BLANK"),^TMP($J,"NURCEN",NROOM,NBED,NAME)=DFN_"^"_VA("PID")_"^"_$P(VAIN(7),"^",2)

PAT D 1^VADPT I '(VADM(1)="") S NAME=VADM(1),NROOM=$S('($P(VAIN(5),"-")=""):$P(VAIN(5),"-"),1:"  BLANK"),NBED=$S('($P(VAIN(5),"-",2)=""):$P(VAIN(5),"-",2),1:"  BLANK"),^TMP($J,"NURCEN",NROOM,NBED,NAME)=DFN_"^"_VA("PID")_"^"_$P(VAIN(7),"^",2)

 S NPWARD=$P($G(^NURSF(214,+DFN,0)),U,3) D EN6^NURSAUTL

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURCAS2   1243     printed  Apr 09, 2024@21:23:28                                                                                                                                                                                                     Page 2

NURCAS2   ;HIRMFO/MD,FT-UTILITY($J) ARRAY BUILDER FOR ASSIGNMENT SHEET ;6/26/97  14:42

 +1       ;;4.0;NURSING SERVICE;**2,24**;Apr 25, 1997

 +2        IF "Pp"[NUREDB

               DO PAT

 +3        IF "Uu"[NUREDB

               DO KVAR^VADPT

               FOR DFN=0:0

                   SET DFN=$ORDER(^NURSF(214,"AF","A",NURWARD,DFN))

                   if DFN'>0

                       QUIT

                   if $EXTRACT(IOST)="C"

                       WRITE "."

                   DO 1^VADPT

                   DO ALLPAT

 +4        IF "Ss"[NUREDB

               FOR DFN=0:0

                   SET DFN=$ORDER(^NURSF(214,"AF","A",NURWARD,DFN))

                   if DFN'>0

                       QUIT

                   DO 1^VADPT

                   if $EXTRACT(IOST)="C"

                       WRITE "."

                   IF VADM(1)'=""

                       DO SELECT

 +5        QUIT

SELECT     SET NROOM=""

FOR

               SET NROOM=$ORDER(NRMBD(NROOM))

               if NROOM=""

                   QUIT

               IF $PIECE($PIECE(VAIN(5),U),"-",1,2)=NROOM

                   DO SELECT1

 +1        QUIT

SELECT1    SET NBED=$SELECT('($PIECE(VAIN(5),"-",2)=""):$PIECE(VAIN(5),"-",2),1:"  BLANK")

           SET NAME=$PIECE(VADM(1),"^")

           SET ^TMP($JOB,"NURCEN",NROOM,NBED,NAME)=DFN_"^"_VA("PID")_"^"_$PIECE(VAIN(7),"^",2)

 +1        QUIT

ALLPAT     IF '(VADM(1)="")

               SET NAME=VADM(1)

               SET NROOM=$SELECT('($PIECE(VAIN(5),"-")=""):$PIECE(VAIN(5),"-"),1:"  BLANK")

               SET NBED=$SELECT('($PIECE(VAIN(5),"-",2)=""):$PIECE(VAIN(5),"-",2),1:"  BLANK")

               SET ^TMP($JOB,"NURCEN",NROOM,NBED,NAME)=DFN_"^"_VA("PID")_"^"_$PIECE(VAIN(7),"^",2)

 +1        QUIT

PAT        DO 1^VADPT

           IF '(VADM(1)="")

               SET NAME=VADM(1)

               SET NROOM=$SELECT('($PIECE(VAIN(5),"-")=""):$PIECE(VAIN(5),"-"),1:"  BLANK")

               SET NBED=$SELECT('($PIECE(VAIN(5),"-",2)=""):$PIECE(VAIN(5),"-",2),1:"  BLANK")

               SET ^TMP($JOB,"NURCEN",NROOM,NBED,NAME)=DFN_"^"_VA("PID")_"^"_$PIECE(VAIN(7),"^",2)

 +1        SET NPWARD=$PIECE($GET(^NURSF(214,+DFN,0)),U,3)

           DO EN6^NURSAUTL

 +2        QUIT

NURCAS2.m