NURAAE1.m

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

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