- NURAAE1 ;HIRMFO/RM-EDIT ACUITY TOTALS...AMIS A1106-cont. ;AUG 1986
- ;;4.0;NURSING SERVICE;**14**;Apr 25, 1997
- EN1 ; CHECK IF THE NODE SELECTED IS VALID AND EXISTS: ENTERED FROM NURAAE0
- S NOSW=0,NURX=RPTDATE_NURSHFT_WARD S DA(1)=$S($D(^NURSA(213.4,"B",NURX)):$O(^NURSA(213.4,"B",NURX,0)),1:($P(^NURSA(213.4,0),U,3)+1)) I $D(^NURSA(213.4,DA(1),1,"B",BEDSECT)) Q
- ADDDAY ;
- W $C(7),!,"THIS COMBINATION YOU HAVE SELECTED DOES NOT EXIST,",!,"WOULD YOU LIKE TO ADD THIS AS NEW DATA" S %=1 D YN^DICN
- I (%=-1)!(%=2) S:%=-1 OUTSW=1 S:%=2 NOSW=1 Q
- I %=0 W !,"ANSWER YES OR NO" G ADDDAY
- D ADDNODE
- Q
- ADDNODE ; ADD RECORD TO ACUITY SUB-FILE
- I $D(^NURSA(213.4,DA(1),0)) G ADDACU
- N NURZERO S NURZERO=$P($G(^NURSA(213.4,0)),"^",3,4),DA(1)=$P(NURZERO,"^")
- LOCK S DA(1)=DA(1)+1 L +^NURSA(213.4,DA(1)):0 I '$T!$D(^NURSA(213.4,DA(1))) L -^NURSA(213.4,DA(1)) G LOCK
- S $P(^NURSA(213.4,0),"^",3,4)=DA(1)_"^"_($P(NURZERO,"^",2)+1),X=RPTDATE_NURSHFT_WARD,^NURSA(213.4,DA(1),0)=X
- S DA=DA(1),DIK="^NURSA(213.4," D IX1^DIK K DIK
- ADDACU S:'$D(^NURSA(213.4,DA(1),1,0)) ^(0)="^213.41PA^^"
- S DA=+$P(^NURSA(213.4,DA(1),1,0),"^",3)
- ADD S DA=DA+1 I $D(^NURSA(213.4,DA(1),1,DA,0)) G ADD
- S $P(^NURSA(213.4,DA(1),1,0),"^",3)=DA,$P(^(0),"^",4)=$P(^(0),"^",4)+1,^NURSA(213.4,DA(1),1,DA,0)=BEDSECT_"^0^0^0^0^0"
- S DIK="^NURSA(213.4,DA(1),1," D IX1^DIK K DIK
- L -^NURSA(213.4,DA(1),0)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURAAE1 1379 printed Jan 18, 2025@03:19:54 Page 2
- NURAAE1 ;HIRMFO/RM-EDIT ACUITY TOTALS...AMIS A1106-cont. ;AUG 1986
- +1 ;;4.0;NURSING SERVICE;**14**;Apr 25, 1997
- EN1 ; CHECK IF THE NODE SELECTED IS VALID AND EXISTS: ENTERED FROM NURAAE0
- +1 SET NOSW=0
- SET NURX=RPTDATE_NURSHFT_WARD
- SET DA(1)=$SELECT($DATA(^NURSA(213.4,"B",NURX)):$ORDER(^NURSA(213.4,"B",NURX,0)),1:($PIECE(^NURSA(213.4,0),U,3)+1))
- IF $DATA(^NURSA(213.4,DA(1),1,"B",BEDSECT))
- QUIT
- ADDDAY ;
- +1 WRITE $CHAR(7),!,"THIS COMBINATION YOU HAVE SELECTED DOES NOT EXIST,",!,"WOULD YOU LIKE TO ADD THIS AS NEW DATA"
- SET %=1
- DO YN^DICN
- +2 IF (%=-1)!(%=2)
- if %=-1
- SET OUTSW=1
- if %=2
- SET NOSW=1
- QUIT
- +3 IF %=0
- WRITE !,"ANSWER YES OR NO"
- GOTO ADDDAY
- +4 DO ADDNODE
- +5 QUIT
- ADDNODE ; ADD RECORD TO ACUITY SUB-FILE
- +1 IF $DATA(^NURSA(213.4,DA(1),0))
- GOTO ADDACU
- +2 NEW NURZERO
- SET NURZERO=$PIECE($GET(^NURSA(213.4,0)),"^",3,4)
- SET DA(1)=$PIECE(NURZERO,"^")
- LOCK SET DA(1)=DA(1)+1
- LOCK +^NURSA(213.4,DA(1)):0
- IF '$TEST!$DATA(^NURSA(213.4,DA(1)))
- LOCK -^NURSA(213.4,DA(1))
- GOTO LOCK
- +1 SET $PIECE(^NURSA(213.4,0),"^",3,4)=DA(1)_"^"_($PIECE(NURZERO,"^",2)+1)
- SET X=RPTDATE_NURSHFT_WARD
- SET ^NURSA(213.4,DA(1),0)=X
- +2 SET DA=DA(1)
- SET DIK="^NURSA(213.4,"
- DO IX1^DIK
- KILL DIK
- ADDACU if '$DATA(^NURSA(213.4,DA(1),1,0))
- SET ^(0)="^213.41PA^^"
- +1 SET DA=+$PIECE(^NURSA(213.4,DA(1),1,0),"^",3)
- ADD SET DA=DA+1
- IF $DATA(^NURSA(213.4,DA(1),1,DA,0))
- GOTO ADD
- +1 SET $PIECE(^NURSA(213.4,DA(1),1,0),"^",3)=DA
- SET $PIECE(^(0),"^",4)=$PIECE(^(0),"^",4)+1
- SET ^NURSA(213.4,DA(1),1,DA,0)=BEDSECT_"^0^0^0^0^0"
- +2 SET DIK="^NURSA(213.4,DA(1),1,"
- DO IX1^DIK
- KILL DIK
- +3 LOCK -^NURSA(213.4,DA(1),0)
- +4 QUIT