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

NURSAL0.m

Go to the documentation of this file.
NURSAL0 ;HIRMFO/JM-DRIVER FOR EDIT,PRINT OPTIONS FOR THE LOCATION REASSIGNMENT OPTION NURSLO-MENU ;8/23/96  10:51
 ;;4.0;NURSING SERVICE;**2**;Apr 25, 1997
EN1 ;ENTRY FROM OPTION NURSLO-PRINT EDIT LOCATION FILE ENTRIES
 S X=$G(^DIC(213.9,1,"OFF"))  Q:X=""!(X=1)
 W ! S DIC="^NURSF(211.4,",DIC(0)="AEMQZ",DIC("A")="Select Nursing Unit:  " D ^DIC K DIC Q:+Y'>0  S NURSREV=1 D EN1^NURSALED K NURSREV
 G EN1
EN2 ;ENTRY FROM OPTION NURSLO-EDIT CURRENT LOCATION ENTRIES
 S X=$G(^DIC(213.9,1,"OFF"))  Q:X=""!(X=1)
 S (NUROUT,NURS132,NURPAGE,NURSW1,NURQUEUE)=0
 S DIR("A")="Select Reporting Option: ",DIR("A",1)="",DIR("A",2)="1. Status/bed section information (80 column)",DIR("A",3)="2. Status/bed section report with budgeted FTEE (132 column)",DIR("A",4)="3. Budgeted FTEE only (80 column)"
 S DIR("A",5)="",DIR(0)="NA^1:3" D ^DIR K DIR I $G(DIRUT) S NUROUT=1 G Q
 S NURSEL=X S:NURSEL=2 NURS132=1 W ! D EN1^NURSAUTL G:NUROUT Q D ASK G:$G(NUROUT) Q
 W ! S ZTRTN="START^NURSAL0" D EN7^NURSUT0 G:POP!($D(ZTSK)) Q
START ;
 K ^TMP($J)
 I 'NURHOSP S NPWARD="" F  S NPWARD=$O(NURSNLOC(NPWARD)) Q:NPWARD=""  S DA=0 F  S DA=$O(NURSNLOC(NPWARD,DA)) Q:DA'>0  D SORT
 I NURHOSP S DA=0 F  S DA=$O(^NURSF(211.4,DA)) Q:DA'>0  I +^(DA,0) D SORT
 W ! D NPRINT
Q K ^TMP($J) D CLOSE^NURSUT1,^NURSKILL
 Q
SORT ;
 W:$E(IOST)="C" " ."
 S X=$$GET1^DIQ(211.4,+DA,.03,"I"),NURSPROG=$S(+X:$P(^NURSF(212.7,+X,0),U),1:""),NURSFAC=$$EN12^NURSUT3(DA)
 I NURHOSP S NPWARD=DA D EN6^NURSAUTL
 I 'NURHOSP,'$D(NURSNLOC(NPWARD)) Q
 I $G(NURFAC)=0,$G(NURSFAC)'=$G(NURFAC(1)) Q
 I $G(NURPLSW)=1,'NURPROG,NURSPROG'=NURPROG(1) Q
 S:NURSPROG="" NURSPROG="*NONE*" S:NURSPROG="NURSING" NURSPROG=" NURSING"
 S ^TMP($J,NURSFAC,NURSPROG,NPWARD,DA)=""
 Q
NPRINT ; 
 S NURFAC=""
 F  S NURFAC=$O(^TMP($J,NURFAC)) Q:NUROUT!(NURFAC="")  D NHDR Q:NUROUT  S NURPROG="" F  S NURPROG=$O(^TMP($J,NURFAC,NURPROG)) D NHDR1 Q:NUROUT!(NURPROG="")  D
 . S NPWARD="" F  S NPWARD=$O(^TMP($J,NURFAC,NURPROG,NPWARD)) Q:NPWARD=""!(NUROUT)  S DA=0 F  S DA=$O(^TMP($J,NURFAC,NURPROG,NPWARD,DA)) Q:NUROUT!(DA'>0)  D WRITE Q:NUROUT
 . Q
 Q
WRITE I 'NURSW1!($Y>(IOSL-6)) D NHDR Q:NUROUT  D NHDR1
 W !,$E(NPWARD,1,10)
 I NURSEL'=3 D
 .  W ?13,$S($P($G(^NURSF(211.4,+DA,1)),U)="A":"ACTIVE",1:"INACTIV"),?24,$S($G(^NURSF(211.4,+DA,"I"))="A":"ACTIVE",1:"**INACTIV")
 .  S D1=0 F  S D1=$O(^NURSF(211.4,DA,4,D1)) Q:D1'>0  W:D1>1 ! S Y=+$G(^NURSF(211.4,DA,4,D1,0)) W ?35,$P($G(^NURSF(213.3,Y,1)),U)
 .  S D1=0 F  S D1=$O(^NURSF(211.4,DA,3,D1)) Q:D1'>0  W:D1>1 ! S X=+$G(^NURSF(211.4,DA,3,D1,0)) W ?46,$E($P($G(^DIC(42,X,0)),U),1,9) S Y=+$P($G(^NURSF(211.4,DA,3,D1,0)),U,2) W ?55,$P($G(^NURSF(213.3,+Y,1)),U)
 .  S Y=+^NURSF(211.4,DA,0) W ?66,$S(+$$LOCSTAT^NURSUT1(Y):"YES",1:"NO")
 .  Q
 I NURS132 D
 .  S NDATA="",NDATA=$G(^NURSF(211.4,DA,1)) W ?75,$P(NDATA,U,2),?84,$E($P($G(^NURSF(211.5,+$P(NDATA,U,3),0)),U),1,9)
 .  S NURPOS=+$G(^NURSF(211.4,DA,0)),PDA=0
 .  F  S PDA=$O(^NURSF(211.8,"B",NURPOS,PDA)) Q:PDA'>0  S NDATA="",NDATA=$G(^NURSF(211.8,PDA,0)) I $G(NDATA)'="" W ?98,$P(NDATA,U,2),?104,$J($$BUDCAT^NURSUT1(PDA),2,3) D  W ! I ($Y>(IOSL-6)) D NHDR Q:NUROUT  D NHDR1
 .  .  S PD1=0 F  S PD1=$O(^NURSF(211.8,PDA,2,PD1)) Q:PD1'>0  S NDATA="",NDATA=$G(^NURSF(211.8,PDA,2,PD1,0)) W ?112,$P($G(^NURSF(211.3,+NDATA,0)),U),?123,$J($P(NDATA,U,2),2,3),!
 .  .  Q
 .  Q
 I NURSEL=3 D
 .  S NDATA="",NDATA=$G(^NURSF(211.4,DA,1)) W ?13,$P(NDATA,U,2),?20,$E($P($G(^NURSF(211.5,+$P(NDATA,U,3),0)),U),1,11)
 .  S NURPOS=+$G(^NURSF(211.4,DA,0)),PDA=0
 .  F  S PDA=$O(^NURSF(211.8,"B",NURPOS,PDA)) Q:PDA'>0  S NDATA="",NDATA=$G(^NURSF(211.8,PDA,0)) I $G(NDATA)'="" W ?37,$P(NDATA,U,2),?45,$J($$BUDCAT^NURSUT1(PDA),2,3) D  W ! I ($Y>(IOSL-6)) D NHDR Q:NUROUT  D NHDR1
 .  .  S PD1=0 F  S PD1=$O(^NURSF(211.8,PDA,2,PD1)) Q:PD1'>0  S NDATA="",NDATA=$G(^NURSF(211.8,PDA,2,PD1,0)) W ?58,$P($G(^NURSF(211.3,+NDATA,0)),U),?70,$J($P(NDATA,U,2),2,3),!
 .  .  Q
 .  Q
 Q
NHDR I '$G(NUROUT),'NURQUEUE,NURSW1,$E(IOST)="C" D ENDPG^NURSUT1 Q:$G(NUROUT)
 S NURPAGE=NURPAGE+1,NURSW1=1
 W:$E(IOST)="C"!(NURPAGE>1) @IOF
 S X="T" D ^%DT D:+Y D^DIQ S NURDT=Y
 W !,"EXISTING LOCATION REPORT",?$S(NURS132:100,1:50),NURDT,?$S(NURS132:124,1:72),"PAGE: ",NURPAGE
 I '(NURSEL=3) W !,?13,"PATIENT",?35,"AMIS",?55,"MAS",!,?13,"CARE",?24,"WARD",?35,"BED",?46,"MAS",?55,"BED",?66,"STAFF"
 I +$G(NURS132) W ?75,"PROF",?84,"UNIT",?94,"SERVICE",?104,"BUDG",?112,"SERVICE",?123,"BUDG"
 I '(NURSEL=3) W !,"NAME",?13,"STATUS",?24,"STATUS",?35,"SECTION",?46,"WARD",?55,"SECTION",?66,"FLAG"
 I +$G(NURS132) W ?76," %",?84,"TYPE",?94,"CATEGORY",?104,"FTEE",?112,"POSITION",?123,"FTEE"
 I NURSEL=3 D
 .  W !,?13,"PROF",?20,"UNIT",?34,"SERVICE",?45,"BUDGETED",?58,"SERVICE",?70,"BUDGETED"
 .  W !,"NAME",?13," %",?20,"TYPE",?34,"CATEGORY",?45,"FTEE",?58,"POSITION",?70,"FTEE"
 .  Q
 W !,$$REPEAT^XLFSTR("-",$S($G(NURS132):132,1:80))
 I $G(NURMDSW) W !!,?10,"FACILITY: ",NURFAC
 Q
NHDR1 I $G(NURPLSW),$G(NURPROG)'="",$G(NURPROG)'="  BLANK" W !?6,"PRODUCT LINE: ",$S($E(NURPROG,1)=" ":$E(NURPROG,2,99),1:$G(NURPROG)),!
 Q
ASK ; ENTRY FOR WARD SELECTION PROMPT
 I $G(NURMDSW) S DIC(0)="AEQZ",NURPLSCR=1 D EN5^NURSAGSP K NURPLSCR Q:$G(NUROUT)
 I '$G(NURMDSW),$G(NURPLSW)=1 S NURPLSCR=1 D PRD^NURSAGSP K NURPLSCR Q:$G(NUROUT)
 W ! D EN1^NURSAGSP Q:$G(NUROUT)
 Q