- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURSCPLE 2075 printed Feb 18, 2025@23:48:13 Page 2
- 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