source: WorldVistAEHR/trunk/r/NURSING_SERVICE-NUR/NURSAL0.m@ 789

Last change on this file since 789 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 5.1 KB
Line 
1NURSAL0 ;HIRMFO/JM-DRIVER FOR EDIT,PRINT OPTIONS FOR THE LOCATION REASSIGNMENT OPTION NURSLO-MENU ;8/23/96 10:51
2 ;;4.0;NURSING SERVICE;**2**;Apr 25, 1997
3EN1 ;ENTRY FROM OPTION NURSLO-PRINT EDIT LOCATION FILE ENTRIES
4 S X=$G(^DIC(213.9,1,"OFF")) Q:X=""!(X=1)
5 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
6 G EN1
7EN2 ;ENTRY FROM OPTION NURSLO-EDIT CURRENT LOCATION ENTRIES
8 S X=$G(^DIC(213.9,1,"OFF")) Q:X=""!(X=1)
9 S (NUROUT,NURS132,NURPAGE,NURSW1,NURQUEUE)=0
10 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)"
11 S DIR("A",5)="",DIR(0)="NA^1:3" D ^DIR K DIR I $G(DIRUT) S NUROUT=1 G Q
12 S NURSEL=X S:NURSEL=2 NURS132=1 W ! D EN1^NURSAUTL G:NUROUT Q D ASK G:$G(NUROUT) Q
13 W ! S ZTRTN="START^NURSAL0" D EN7^NURSUT0 G:POP!($D(ZTSK)) Q
14START ;
15 K ^TMP($J)
16 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
17 I NURHOSP S DA=0 F S DA=$O(^NURSF(211.4,DA)) Q:DA'>0 I +^(DA,0) D SORT
18 W ! D NPRINT
19Q K ^TMP($J) D CLOSE^NURSUT1,^NURSKILL
20 Q
21SORT ;
22 W:$E(IOST)="C" " ."
23 S X=$$GET1^DIQ(211.4,+DA,.03,"I"),NURSPROG=$S(+X:$P(^NURSF(212.7,+X,0),U),1:""),NURSFAC=$$EN12^NURSUT3(DA)
24 I NURHOSP S NPWARD=DA D EN6^NURSAUTL
25 I 'NURHOSP,'$D(NURSNLOC(NPWARD)) Q
26 I $G(NURFAC)=0,$G(NURSFAC)'=$G(NURFAC(1)) Q
27 I $G(NURPLSW)=1,'NURPROG,NURSPROG'=NURPROG(1) Q
28 S:NURSPROG="" NURSPROG="*NONE*" S:NURSPROG="NURSING" NURSPROG=" NURSING"
29 S ^TMP($J,NURSFAC,NURSPROG,NPWARD,DA)=""
30 Q
31NPRINT ;
32 S NURFAC=""
33 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
34 . 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
35 . Q
36 Q
37WRITE I 'NURSW1!($Y>(IOSL-6)) D NHDR Q:NUROUT D NHDR1
38 W !,$E(NPWARD,1,10)
39 I NURSEL'=3 D
40 . 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")
41 . 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)
42 . 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)
43 . S Y=+^NURSF(211.4,DA,0) W ?66,$S(+$$LOCSTAT^NURSUT1(Y):"YES",1:"NO")
44 . Q
45 I NURS132 D
46 . 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)
47 . S NURPOS=+$G(^NURSF(211.4,DA,0)),PDA=0
48 . 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
49 . . 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),!
50 . . Q
51 . Q
52 I NURSEL=3 D
53 . 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)
54 . S NURPOS=+$G(^NURSF(211.4,DA,0)),PDA=0
55 . 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
56 . . 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),!
57 . . Q
58 . Q
59 Q
60NHDR I '$G(NUROUT),'NURQUEUE,NURSW1,$E(IOST)="C" D ENDPG^NURSUT1 Q:$G(NUROUT)
61 S NURPAGE=NURPAGE+1,NURSW1=1
62 W:$E(IOST)="C"!(NURPAGE>1) @IOF
63 S X="T" D ^%DT D:+Y D^DIQ S NURDT=Y
64 W !,"EXISTING LOCATION REPORT",?$S(NURS132:100,1:50),NURDT,?$S(NURS132:124,1:72),"PAGE: ",NURPAGE
65 I '(NURSEL=3) W !,?13,"PATIENT",?35,"AMIS",?55,"MAS",!,?13,"CARE",?24,"WARD",?35,"BED",?46,"MAS",?55,"BED",?66,"STAFF"
66 I +$G(NURS132) W ?75,"PROF",?84,"UNIT",?94,"SERVICE",?104,"BUDG",?112,"SERVICE",?123,"BUDG"
67 I '(NURSEL=3) W !,"NAME",?13,"STATUS",?24,"STATUS",?35,"SECTION",?46,"WARD",?55,"SECTION",?66,"FLAG"
68 I +$G(NURS132) W ?76," %",?84,"TYPE",?94,"CATEGORY",?104,"FTEE",?112,"POSITION",?123,"FTEE"
69 I NURSEL=3 D
70 . W !,?13,"PROF",?20,"UNIT",?34,"SERVICE",?45,"BUDGETED",?58,"SERVICE",?70,"BUDGETED"
71 . W !,"NAME",?13," %",?20,"TYPE",?34,"CATEGORY",?45,"FTEE",?58,"POSITION",?70,"FTEE"
72 . Q
73 W !,$$REPEAT^XLFSTR("-",$S($G(NURS132):132,1:80))
74 I $G(NURMDSW) W !!,?10,"FACILITY: ",NURFAC
75 Q
76NHDR1 I $G(NURPLSW),$G(NURPROG)'="",$G(NURPROG)'=" BLANK" W !?6,"PRODUCT LINE: ",$S($E(NURPROG,1)=" ":$E(NURPROG,2,99),1:$G(NURPROG)),!
77 Q
78ASK ; ENTRY FOR WARD SELECTION PROMPT
79 I $G(NURMDSW) S DIC(0)="AEQZ",NURPLSCR=1 D EN5^NURSAGSP K NURPLSCR Q:$G(NUROUT)
80 I '$G(NURMDSW),$G(NURPLSW)=1 S NURPLSCR=1 D PRD^NURSAGSP K NURPLSCR Q:$G(NUROUT)
81 W ! D EN1^NURSAGSP Q:$G(NUROUT)
82 Q
Note: See TracBrowser for help on using the repository browser.