- 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
- Q
- SELECT S NROOM="" F S NROOM=$O(NRMBD(NROOM)) Q:NROOM="" I $P($P(VAIN(5),U),"-",1,2)=NROOM D SELECT1
- Q
- 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)
- Q
- 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)
- Q
- 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
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURCAS2 1243 printed Feb 18, 2025@23:46:34 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