NURSCPLE.m

NURSCPLE ;HIRMFO/RM,FT/MD-BACKUP BED CONTROL FOR NURSING SERVICE ;4/23/97

 ;;4.0;NURSING SERVICE;;Apr 25, 1997

EN1 ; ENTRY FROM ROUTINE NURACE0 TO UPDATE NURS PATIENT LOCATION

 Q:'$D(^DIC(213.9,1,"OFF"))  Q:$P(^DIC(213.9,1,"OFF"),"^",1)=1

 S NADM=0 D EDT

Q1 ; KILL LOCAL VARIABLES

 D ^NURSKILL

 Q

EDT W !! S NASK=1,DIC(0)="EQM",NACT=0 D EN5^NURSCUTL G:DFN="" Q1 I '$D(^NURSF(214,"C","A",DFN)),'NADM W !,$C(7),"Patient not admitted in Nursing Package" G Q1

 L +^NURSF(214,DFN):3 I '$T W !,"CANNOT EDIT AT THIS TIME" G Q1

 D:NADM ADM

 S NURLSCR=1,DA=DFN,DIE="^NURSF(214,"

 S DR="2Select Nursing Unit;S NURSS=$S('$D(^NURSF(211.4,X,""I"")):""A"",$P(^(""I""),U)=""A"":""A"",1:""I""),NURSS=$S(NURSS=""I"":""I"",'$D(^(1)):""A"",1:$P(^(1),U));1///^S X=NURSS;K NURSS;3Select Nursing Bed Section"

 D ^DIE K NURLSCR L -^NURSF(214,DFN)

 I $S('$D(^NURSF(214,DFN,0)):1,$P(^(0),"^",3)="":1,$P(^(0),"^",4)="":1,1:0) S DA=DFN,DIK="^NURSF(214," D ^DIK W !,$C(7),"Patient not admitted to Nursing!!"

 Q

EN2 ; CALLED FROM OPTION NURSPT-ACT BACKUP TO MAS TO ADMIT PATIENT

 ; INTO NURSING SERVICE.

 Q:'$D(^DIC(213.9,1,"OFF"))  Q:$P(^DIC(213.9,1,"OFF"),"^",1)=1

 S NADM=1 D EDT

 G Q1

ADM S DA=DFN,DIE=214,DR=$S('$D(^NURSF(214,DFN,0)):".01///^S X=""`""_DFN;",1:"")_"1///^S X=""A"";4///^S X=DT;5///@" D ^DIE

 D DEM^VADPT W !!,VADM(1)," has been admitted into the NURSING SYSTEM."

 Q

EN3 ; ENTRY FOR INDIVIDUAL PATIENT CENSUS

 Q:'$D(^DIC(213.9,1,"OFF"))  Q:$P(^DIC(213.9,1,"OFF"),"^",1)=1

 S NURQUEUE=0,NASK=1,DIC(0)="EQM",NACT=1 W ! D EN5^NURSCUTL

 G:DFN="" QUIT^NURSCPLC

 S NPWARD=$P(^NURSF(214,DFN,0),"^",3) D EN6^NURSAUTL S NURSWARD=NPWARD

 S NSEC=$S('$D(^NURSF(214,DFN,0)):"",$P(^(0),"^",4)="":"",'$D(^NURSF(213.3,$P(^NURSF(214,DFN,0),"^",4),0)):"",1:$P(^NURSF(213.3,$P(^NURSF(214,DFN,0),"^",4),1),"^",1))

 D FNDCLAS^NURSCPLC D OERR^VADPT

 S N1=VADM(1),SSN=VA("PID"),NBED=VAIN(5)

 D ^NURSAPCH

 W !,"NAME: "_N1_"     "_SSN

 W !,"UNIT: "_NURSWARD

 W !,"ROOM-BED: "_NBED

 W !,"ABSENCE: "_NURSX

 W !,"BED SEC: "_NSEC

 W !,"ACUITY: "_NURCAT

 D QUIT^NURSCPLC

 Q

NURSCPLE  ;HIRMFO/RM,FT/MD-BACKUP BED CONTROL FOR NURSING SERVICE ;4/23/97

 +1       ;;4.0;NURSING SERVICE;;Apr 25, 1997

EN1       ; ENTRY FROM ROUTINE NURACE0 TO UPDATE NURS PATIENT LOCATION

 +1        IF '$DATA(^DIC(213.9,1,"OFF"))

               QUIT 

           IF $PIECE(^DIC(213.9,1,"OFF"),"^",1)=1

               QUIT 

 +2        SET NADM=0

           DO EDT

Q1        ; KILL LOCAL VARIABLES

 +1        DO ^NURSKILL

 +2        QUIT 

EDT        WRITE !!

           SET NASK=1

           SET DIC(0)="EQM"

           SET NACT=0

           DO EN5^NURSCUTL

           IF DFN=""

               GOTO Q1

           IF '$DATA(^NURSF(214,"C","A",DFN))

               IF 'NADM

                   WRITE !,$CHAR(7),"Patient not admitted in Nursing Package"

                   GOTO Q1

 +1        LOCK +^NURSF(214,DFN):3

           IF '$TEST

               WRITE !,"CANNOT EDIT AT THIS TIME"

               GOTO Q1

 +2        IF NADM

               DO ADM

 +3        SET NURLSCR=1

           SET DA=DFN

           SET DIE="^NURSF(214,"

 +4        SET DR="2Select Nursing Unit;S NURSS=$S('$D(^NURSF(211.4,X,""I"")):""A"",$P(^(""I""),U)=""A"":""A"",1:""I""),NURSS=$S(NURSS=""I"":""I"",'$D(^(1)):""A"",1:$P(^(1),U));1///^S X=NURSS;K NURSS;3Select Nursing Bed Section"

 +5        DO ^DIE

           KILL NURLSCR

           LOCK -^NURSF(214,DFN)

 +6        IF $SELECT('$DATA(^NURSF(214,DFN,0)):1,$PIECE(^(0),"^",3)="":1,$PIECE(^(0),"^",4)="":1,1:0)

               SET DA=DFN

               SET DIK="^NURSF(214,"

               DO ^DIK

               WRITE !,$CHAR(7),"Patient not admitted to Nursing!!"

 +7        QUIT 

EN2       ; CALLED FROM OPTION NURSPT-ACT BACKUP TO MAS TO ADMIT PATIENT

 +1       ; INTO NURSING SERVICE.

 +2        IF '$DATA(^DIC(213.9,1,"OFF"))

               QUIT 

           IF $PIECE(^DIC(213.9,1,"OFF"),"^",1)=1

               QUIT 

 +3        SET NADM=1

           DO EDT

 +4        GOTO Q1

ADM        SET DA=DFN

           SET DIE=214

           SET DR=$SELECT('$DATA(^NURSF(214,DFN,0)):".01///^S X=""`""_DFN;",1:"")_"1///^S X=""A"";4///^S X=DT;5///@"

           DO ^DIE

 +1        DO DEM^VADPT

           WRITE !!,VADM(1)," has been admitted into the NURSING SYSTEM."

 +2        QUIT 

EN3       ; ENTRY FOR INDIVIDUAL PATIENT CENSUS

 +1        IF '$DATA(^DIC(213.9,1,"OFF"))

               QUIT 

           IF $PIECE(^DIC(213.9,1,"OFF"),"^",1)=1

               QUIT 

 +2        SET NURQUEUE=0

           SET NASK=1

           SET DIC(0)="EQM"

           SET NACT=1

           WRITE !

           DO EN5^NURSCUTL

 +3        IF DFN=""

               GOTO QUIT^NURSCPLC

 +4        SET NPWARD=$PIECE(^NURSF(214,DFN,0),"^",3)

           DO EN6^NURSAUTL

           SET NURSWARD=NPWARD

 +5        SET NSEC=$SELECT('$DATA(^NURSF(214,DFN,0)):"",$PIECE(^(0),"^",4)="":"",'$DATA(^NURSF(213.3,$PIECE(^NURSF(214,DFN,0),"^",4),0)):"",1:$PIECE(^NURSF(213.3,$PIECE(^NURSF(214,DFN,0),"^",4),1),"^",1))

 +6        DO FNDCLAS^NURSCPLC

           DO OERR^VADPT

 +7        SET N1=VADM(1)

           SET SSN=VA("PID")

           SET NBED=VAIN(5)

 +8        DO ^NURSAPCH

 +9        WRITE !,"NAME: "_N1_"     "_SSN

 +10       WRITE !,"UNIT: "_NURSWARD

 +11       WRITE !,"ROOM-BED: "_NBED

 +12       WRITE !,"ABSENCE: "_NURSX

 +13       WRITE !,"BED SEC: "_NSEC

 +14       WRITE !,"ACUITY: "_NURCAT

 +15       DO QUIT^NURSCPLC

 +16       QUIT