NURSCPLU ;HIRMFO/RM,FT-Create NURSING FILE AND XREFS ;8/14/96 10:22
;;4.0;NURSING SERVICE;;Apr 25, 1997
EN1 ; ENTRY FROM OPTION NURSPT-WRDACT
S X="A"
G MAIN
EN2 ; ENTRY FROM OPTION NURSPT-WRDINA
S X="I"
MAIN ;
Q:'$D(^DIC(213.9,1,"OFF")) Q:$P(^DIC(213.9,1,"OFF"),"^",1)=1
S NURSTUS=X
D CKMAS I NURSBAD Q
S NURSEND=0
D DATACK
D:'NURSDATA FIRSTIME I NURSEND K NURSEND Q
D WARDSEL I $G(NURSEND) K NURSEND Q
D INIT214 K NURSEND
Q
FIRSTIME ; IF NO DATA IN NURS PATIENT (214) FILE INITIALIZE IT
D EN1^NURSCPL
I NURSBAD S NURSEND=1 Q
D INIT214 K NURSWRD
S NURSDATA=1
Q
DATACK ; CHECK TO SEE IF DATA IN THE 214 FILE
S NURSDATA=0,NURSCK=$O(^NURSF(214,0))
S:NURSCK>0 NURSDATA=1
Q
WARDSEL ; SELECT WARD TO BE ACTIVATED
S NURSEND=0,OUTSW=0
F NURSI=1:1 S DIC="^NURSF(211.4,",DIC("S")="I $S('$D(^(""I"")):1,$P(^(""I""),U)'=""I"":1,1:0)",DIC(0)="AEM",DIC("A")="Select UNIT: " D ^DIC K DIC S:X="^" NURSEND=1,OUTSW=1 S:(X="")!(+Y'>0) OUTSW=1 S:(X="")&'$D(NURSWRD) NURSEND=1 Q:OUTSW D
.S NURSWRD(NURSI)=+Y
.Q
I NURSEND Q
D:'$G(NURSEND) ACTWARD
Q
ACTWARD ; SET WARD STATUS TO ACTIVE
F NURSI=0:0 S NURSI=$O(NURSWRD(NURSI)) Q:NURSI'>0 S DA=NURSWRD(NURSI),DIE="^NURSF(211.4,",DR="1///^S X=NURSTUS" D ^DIE
Q
CKMAS ; CHECKS EVERY MAS WARD TO SEE IF CORR. NURSING LOCATION
W !!,"Checking to see if every MAS Ward has a corresponding NURSING unit"
S NURSERR=0
F NURSY=0:0 S NURSY=$O(^DIC(42,NURSY)) S:(NURSY'>0)&(NURSERR) NURSBAD=1 Q:NURSY'>0 S X=$P(^DIC(42,NURSY,0),"^",1) D ^NURSAWCK S:NURSBAD NURSERR=1
I NURSBAD D BADWARD^NURSAWCK W !!!,$C(7),"Press return to continue: " R X:DTIME Q
Q
INIT214 ; ENTERS PATIENTS INTO 214 FILE FROM 2 FILE
W:'$G(NURSDATA) !!,"Set up initial Nursing Patient file entries for inpatients"
W:$G(NURSDATA) !!,"Ward "_$S(NURSTUS="A":"A",1:"Dea")_"ctivation and Patient entry for the following Nursing unit(s):"
D DT^DICRW S U="^" D F1:$G(NURSTUS)="A",F3:$G(NURSTUS)="I"
W !!,"Done ... "
Q
F1 ; ACTIVIATION PROCESS
F NURSY=0:0 S NURSY=$O(NURSWRD(NURSY)) Q:NURSY'>0 S NPWARD=NURSWRD(NURSY) D EN6^NURSAUTL W !," ",NPWARD F NURSZ=0:0 S NURSZ=$O(^NURSF(211.4,NURSWRD(NURSY),3,NURSZ)) Q:NURSZ'>0 D F10
Q
F10 ;
S NURSWRD=$S($D(^NURSF(211.4,NURSWRD(NURSY),3,NURSZ,0)):$S($D(^DIC(42,+^NURSF(211.4,NURSWRD(NURSY),3,NURSZ,0),0)):$P(^(0),"^"),1:""),1:"")
I NURSWRD'="" F DFN=0:0 S DFN=$O(^DPT("CN",NURSWRD,DFN)) Q:DFN'>0 D F2
Q
F2 ; ACTIVATE PATIENT
I '$D(^DPT(DFN,.1)),'$D(^DPT(DFN)) W !!,*7,*7,"PATIENT WITH IEN#",DFN," DOES NOT HAVE A RECORD",!,"IN THE PATIENT FILE." Q
I '$D(^DPT(DFN,.1)) W !!,*7,*7,$P(^DPT(DFN,0),"^",1)," CANNOT BE ADMITTED INTO",!,"THE NURSING SERVICE BECAUSE OF A PROBLEM WITH THE MAS PATIENT FILE -- NOTIFY MAS" Q
I NURSDATA D MASCK Q:NURSNOTV
S X=^DPT(DFN,.1)
S DA=DFN,DIC="" D EN1^NURSCPL
Q
F3 ; DEACTIVATION PROCESS
F NURSY=0:0 S NURSY=$O(NURSWRD(NURSY)) Q:NURSY'>0 S (NPWARD,NURSWRD)=NURSWRD(NURSY) D EN6^NURSAUTL W !," "_NPWARD F DA=0:0 S DA=$O(^NURSF(214,"AF","A",NURSWRD,DA)) Q:DA'>0 S X=NURSWRD D EN2^NURSCPL
Q
MASCK ; CHECKS TO SEE IF THE MAS WARD IS AN ACTIVATED NURSE LOCATION.
S NURSWARD=$S($P(^DPT(DFN,.1),"^",1)="":"",1:$O(^DIC(42,"B",$P(^DPT(DFN,.1),"^",1),"")))
S NURSNOTV=1
Q:NURSWARD=""
F NURSWCK=0:0 S NURSWCK=$O(^NURSF(211.4,"C",NURSWARD,NURSWCK)) Q:NURSWCK'>0 D WARDCK Q:'NURSNOTV
Q
WARDCK ; THIS CHECKS THAT THE NURSE LOCATION WAS ONE SELECTED TO ACTIVATE
F NURSI=0:0 S NURSI=$O(NURSWRD(NURSI)) Q:(NURSI'>0)!('NURSNOTV) S:NURSWCK=NURSWRD(NURSI) NURSNOTV=0
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURSCPLU 3551 printed Apr 09, 2024@21:23:29 Page 2
NURSCPLU ;HIRMFO/RM,FT-Create NURSING FILE AND XREFS ;8/14/96 10:22
+1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
EN1 ; ENTRY FROM OPTION NURSPT-WRDACT
+1 SET X="A"
+2 GOTO MAIN
EN2 ; ENTRY FROM OPTION NURSPT-WRDINA
+1 SET X="I"
MAIN ;
+1 if '$DATA(^DIC(213.9,1,"OFF"))
QUIT
if $PIECE(^DIC(213.9,1,"OFF"),"^",1)=1
QUIT
+2 SET NURSTUS=X
+3 DO CKMAS
IF NURSBAD
QUIT
+4 SET NURSEND=0
+5 DO DATACK
+6 if 'NURSDATA
DO FIRSTIME
IF NURSEND
KILL NURSEND
QUIT
+7 DO WARDSEL
IF $GET(NURSEND)
KILL NURSEND
QUIT
+8 DO INIT214
KILL NURSEND
+9 QUIT
FIRSTIME ; IF NO DATA IN NURS PATIENT (214) FILE INITIALIZE IT
+1 DO EN1^NURSCPL
+2 IF NURSBAD
SET NURSEND=1
QUIT
+3 DO INIT214
KILL NURSWRD
+4 SET NURSDATA=1
+5 QUIT
DATACK ; CHECK TO SEE IF DATA IN THE 214 FILE
+1 SET NURSDATA=0
SET NURSCK=$ORDER(^NURSF(214,0))
+2 if NURSCK>0
SET NURSDATA=1
+3 QUIT
WARDSEL ; SELECT WARD TO BE ACTIVATED
+1 SET NURSEND=0
SET OUTSW=0
+2 FOR NURSI=1:1
SET DIC="^NURSF(211.4,"
SET DIC("S")="I $S('$D(^(""I"")):1,$P(^(""I""),U)'=""I"":1,1:0)"
SET DIC(0)="AEM"
SET DIC("A")="Select UNIT: "
DO ^DIC
KILL DIC
if X="^"
SET NURSEND=1
SET OUTSW=1
if (X="")!(+Y'>0)
SET OUTSW=1
if (X="")&'$DATA(NURSWRD)
SET NURSEND=1
if OUTSW
QUIT
Begin DoDot:1
+3 SET NURSWRD(NURSI)=+Y
+4 QUIT
End DoDot:1
+5 IF NURSEND
QUIT
+6 if '$GET(NURSEND)
DO ACTWARD
+7 QUIT
ACTWARD ; SET WARD STATUS TO ACTIVE
+1 FOR NURSI=0:0
SET NURSI=$ORDER(NURSWRD(NURSI))
if NURSI'>0
QUIT
SET DA=NURSWRD(NURSI)
SET DIE="^NURSF(211.4,"
SET DR="1///^S X=NURSTUS"
DO ^DIE
+2 QUIT
CKMAS ; CHECKS EVERY MAS WARD TO SEE IF CORR. NURSING LOCATION
+1 WRITE !!,"Checking to see if every MAS Ward has a corresponding NURSING unit"
+2 SET NURSERR=0
+3 FOR NURSY=0:0
SET NURSY=$ORDER(^DIC(42,NURSY))
if (NURSY'>0)&(NURSERR)
SET NURSBAD=1
if NURSY'>0
QUIT
SET X=$PIECE(^DIC(42,NURSY,0),"^",1)
DO ^NURSAWCK
if NURSBAD
SET NURSERR=1
+4 IF NURSBAD
DO BADWARD^NURSAWCK
WRITE !!!,$CHAR(7),"Press return to continue: "
READ X:DTIME
QUIT
+5 QUIT
INIT214 ; ENTERS PATIENTS INTO 214 FILE FROM 2 FILE
+1 if '$GET(NURSDATA)
WRITE !!,"Set up initial Nursing Patient file entries for inpatients"
+2 if $GET(NURSDATA)
Press return to continue: WRITE !!,"Ward "_$SELECT(NURSTUS="A":"A",1:"Dea")_"ctivation and Patient entry for the following Nursing unit(s):"
+3 DO DT^DICRW
SET U="^"
if $GET(NURSTUS)="A"
DO F1
if $GET(NURSTUS)="I"
DO F3
+4 WRITE !!,"Done ... "
+5 QUIT
F1 ; ACTIVIATION PROCESS
+1 FOR NURSY=0:0
SET NURSY=$ORDER(NURSWRD(NURSY))
if NURSY'>0
QUIT
SET NPWARD=NURSWRD(NURSY)
DO EN6^NURSAUTL
WRITE !," ",NPWARD
FOR NURSZ=0:0
SET NURSZ=$ORDER(^NURSF(211.4,NURSWRD(NURSY),3,NURSZ))
if NURSZ'>0
QUIT
DO F10
+2 QUIT
F10 ;
+1 SET NURSWRD=$SELECT($DATA(^NURSF(211.4,NURSWRD(NURSY),3,NURSZ,0)):$SELECT($DATA(^DIC(42,+^NURSF(211.4,NURSWRD(NURSY),3,NURSZ,0),0)):$PIECE(^(0),"^"),1:""),1:"")
+2 IF NURSWRD'=""
FOR DFN=0:0
SET DFN=$ORDER(^DPT("CN",NURSWRD,DFN))
if DFN'>0
QUIT
DO F2
+3 QUIT
F2 ; ACTIVATE PATIENT
+1 IF '$DATA(^DPT(DFN,.1))
IF '$DATA(^DPT(DFN))
WRITE !!,*7,*7,"PATIENT WITH IEN#",DFN," DOES NOT HAVE A RECORD",!,"IN THE PATIENT FILE."
QUIT
+2 IF '$DATA(^DPT(DFN,.1))
WRITE !!,*7,*7,$PIECE(^DPT(DFN,0),"^",1)," CANNOT BE ADMITTED INTO",!,"THE NURSING SERVICE BECAUSE OF A PROBLEM WITH THE MAS PATIENT FILE -- NOTIFY MAS"
QUIT
+3 IF NURSDATA
DO MASCK
if NURSNOTV
QUIT
+4 SET X=^DPT(DFN,.1)
+5 SET DA=DFN
SET DIC=""
DO EN1^NURSCPL
+6 QUIT
F3 ; DEACTIVATION PROCESS
+1 FOR NURSY=0:0
SET NURSY=$ORDER(NURSWRD(NURSY))
if NURSY'>0
QUIT
SET (NPWARD,NURSWRD)=NURSWRD(NURSY)
DO EN6^NURSAUTL
WRITE !," "_NPWARD
FOR DA=0:0
SET DA=$ORDER(^NURSF(214,"AF","A",NURSWRD,DA))
if DA'>0
QUIT
SET X=NURSWRD
DO EN2^NURSCPL
+2 QUIT
MASCK ; CHECKS TO SEE IF THE MAS WARD IS AN ACTIVATED NURSE LOCATION.
+1 SET NURSWARD=$SELECT($PIECE(^DPT(DFN,.1),"^",1)="":"",1:$ORDER(^DIC(42,"B",$PIECE(^DPT(DFN,.1),"^",1),"")))
+2 SET NURSNOTV=1
+3 if NURSWARD=""
QUIT
+4 FOR NURSWCK=0:0
SET NURSWCK=$ORDER(^NURSF(211.4,"C",NURSWARD,NURSWCK))
if NURSWCK'>0
QUIT
DO WARDCK
if 'NURSNOTV
QUIT
+5 QUIT
WARDCK ; THIS CHECKS THAT THE NURSE LOCATION WAS ONE SELECTED TO ACTIVATE
+1 FOR NURSI=0:0
SET NURSI=$ORDER(NURSWRD(NURSI))
if (NURSI'>0)!('NURSNOTV)
QUIT
if NURSWCK=NURSWRD(NURSI)
SET NURSNOTV=0
+2 QUIT
