Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: NURSCPLU

NURSCPLU.m

Go to the documentation of this file.
  1. NURSCPLU ;HIRMFO/RM,FT-Create NURSING FILE AND XREFS ;8/14/96 10:22
  1. ;;4.0;NURSING SERVICE;;Apr 25, 1997
  1. EN1 ; ENTRY FROM OPTION NURSPT-WRDACT
  1. S X="A"
  1. G MAIN
  1. EN2 ; ENTRY FROM OPTION NURSPT-WRDINA
  1. S X="I"
  1. MAIN ;
  1. Q:'$D(^DIC(213.9,1,"OFF")) Q:$P(^DIC(213.9,1,"OFF"),"^",1)=1
  1. S NURSTUS=X
  1. D CKMAS I NURSBAD Q
  1. S NURSEND=0
  1. D DATACK
  1. D:'NURSDATA FIRSTIME I NURSEND K NURSEND Q
  1. D WARDSEL I $G(NURSEND) K NURSEND Q
  1. D INIT214 K NURSEND
  1. Q
  1. FIRSTIME ; IF NO DATA IN NURS PATIENT (214) FILE INITIALIZE IT
  1. D EN1^NURSCPL
  1. I NURSBAD S NURSEND=1 Q
  1. D INIT214 K NURSWRD
  1. S NURSDATA=1
  1. Q
  1. DATACK ; CHECK TO SEE IF DATA IN THE 214 FILE
  1. S NURSDATA=0,NURSCK=$O(^NURSF(214,0))
  1. S:NURSCK>0 NURSDATA=1
  1. Q
  1. WARDSEL ; SELECT WARD TO BE ACTIVATED
  1. S NURSEND=0,OUTSW=0
  1. 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
  1. .S NURSWRD(NURSI)=+Y
  1. .Q
  1. I NURSEND Q
  1. D:'$G(NURSEND) ACTWARD
  1. Q
  1. ACTWARD ; SET WARD STATUS TO ACTIVE
  1. 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
  1. Q
  1. CKMAS ; CHECKS EVERY MAS WARD TO SEE IF CORR. NURSING LOCATION
  1. W !!,"Checking to see if every MAS Ward has a corresponding NURSING unit"
  1. S NURSERR=0
  1. 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
  1. I NURSBAD D BADWARD^NURSAWCK W !!!,$C(7),"Press return to continue: " R X:DTIME Q
  1. Q
  1. INIT214 ; ENTERS PATIENTS INTO 214 FILE FROM 2 FILE
  1. W:'$G(NURSDATA) !!,"Set up initial Nursing Patient file entries for inpatients"
  1. W:$G(NURSDATA) !!,"Ward "_$S(NURSTUS="A":"A",1:"Dea")_"ctivation and Patient entry for the following Nursing unit(s):"
  1. D DT^DICRW S U="^" D F1:$G(NURSTUS)="A",F3:$G(NURSTUS)="I"
  1. W !!,"Done ... "
  1. Q
  1. F1 ; ACTIVIATION PROCESS
  1. 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
  1. Q
  1. F10 ;
  1. 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:"")
  1. I NURSWRD'="" F DFN=0:0 S DFN=$O(^DPT("CN",NURSWRD,DFN)) Q:DFN'>0 D F2
  1. Q
  1. F2 ; ACTIVATE PATIENT
  1. 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
  1. 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
  1. I NURSDATA D MASCK Q:NURSNOTV
  1. S X=^DPT(DFN,.1)
  1. S DA=DFN,DIC="" D EN1^NURSCPL
  1. Q
  1. F3 ; DEACTIVATION PROCESS
  1. 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
  1. Q
  1. MASCK ; CHECKS TO SEE IF THE MAS WARD IS AN ACTIVATED NURSE LOCATION.
  1. S NURSWARD=$S($P(^DPT(DFN,.1),"^",1)="":"",1:$O(^DIC(42,"B",$P(^DPT(DFN,.1),"^",1),"")))
  1. S NURSNOTV=1
  1. Q:NURSWARD=""
  1. F NURSWCK=0:0 S NURSWCK=$O(^NURSF(211.4,"C",NURSWARD,NURSWCK)) Q:NURSWCK'>0 D WARDCK Q:'NURSNOTV
  1. Q
  1. WARDCK ; THIS CHECKS THAT THE NURSE LOCATION WAS ONE SELECTED TO ACTIVATE
  1. F NURSI=0:0 S NURSI=$O(NURSWRD(NURSI)) Q:(NURSI'>0)!('NURSNOTV) S:NURSWCK=NURSWRD(NURSI) NURSNOTV=0
  1. Q