- 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 Feb 18, 2025@23:48:14 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)
- 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
- Press return to continue: 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