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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURSAL0 5308 printed Dec 13, 2024@02:21:30 Page 2
NURSAL0 ;HIRMFO/JM-DRIVER FOR EDIT,PRINT OPTIONS FOR THE LOCATION REASSIGNMENT OPTION NURSLO-MENU ;8/23/96 10:51
+1 ;;4.0;NURSING SERVICE;**2**;Apr 25, 1997
EN1 ;ENTRY FROM OPTION NURSLO-PRINT EDIT LOCATION FILE ENTRIES
+1 SET X=$GET(^DIC(213.9,1,"OFF"))
if X=""!(X=1)
QUIT
+2 WRITE !
SET DIC="^NURSF(211.4,"
SET DIC(0)="AEMQZ"
SET DIC("A")="Select Nursing Unit: "
DO ^DIC
KILL DIC
if +Y'>0
QUIT
SET NURSREV=1
DO EN1^NURSALED
KILL NURSREV
+3 GOTO EN1
EN2 ;ENTRY FROM OPTION NURSLO-EDIT CURRENT LOCATION ENTRIES
+1 SET X=$GET(^DIC(213.9,1,"OFF"))
if X=""!(X=1)
QUIT
+2 SET (NUROUT,NURS132,NURPAGE,NURSW1,NURQUEUE)=0
+3 SET DIR("A")="Select Reporting Option: "
SET DIR("A",1)=""
SET DIR("A",2)="1. Status/bed section information (80 column)"
SET DIR("A",3)="2. Status/bed section report with budgeted FTEE (132 column)"
SET DIR("A",4)="3. Budgeted FTEE only (80 column)"
+4 SET DIR("A",5)=""
SET DIR(0)="NA^1:3"
DO ^DIR
KILL DIR
IF $GET(DIRUT)
SET NUROUT=1
GOTO Q
+5 SET NURSEL=X
if NURSEL=2
SET NURS132=1
WRITE !
DO EN1^NURSAUTL
if NUROUT
GOTO Q
DO ASK
if $GET(NUROUT)
GOTO Q
+6 WRITE !
SET ZTRTN="START^NURSAL0"
DO EN7^NURSUT0
if POP!($DATA(ZTSK))
GOTO Q
START ;
+1 KILL ^TMP($JOB)
+2 IF 'NURHOSP
SET NPWARD=""
FOR
SET NPWARD=$ORDER(NURSNLOC(NPWARD))
if NPWARD=""
QUIT
SET DA=0
FOR
SET DA=$ORDER(NURSNLOC(NPWARD,DA))
if DA'>0
QUIT
DO SORT
+3 IF NURHOSP
SET DA=0
FOR
SET DA=$ORDER(^NURSF(211.4,DA))
if DA'>0
QUIT
IF +^(DA,0)
DO SORT
+4 WRITE !
DO NPRINT
Q KILL ^TMP($JOB)
DO CLOSE^NURSUT1
DO ^NURSKILL
+1 QUIT
SORT ;
+1 if $EXTRACT(IOST)="C"
WRITE " ."
+2 SET X=$$GET1^DIQ(211.4,+DA,.03,"I")
SET NURSPROG=$SELECT(+X:$PIECE(^NURSF(212.7,+X,0),U),1:"")
SET NURSFAC=$$EN12^NURSUT3(DA)
+3 IF NURHOSP
SET NPWARD=DA
DO EN6^NURSAUTL
+4 IF 'NURHOSP
IF '$DATA(NURSNLOC(NPWARD))
QUIT
+5 IF $GET(NURFAC)=0
IF $GET(NURSFAC)'=$GET(NURFAC(1))
QUIT
+6 IF $GET(NURPLSW)=1
IF 'NURPROG
IF NURSPROG'=NURPROG(1)
QUIT
+7 if NURSPROG=""
SET NURSPROG="*NONE*"
if NURSPROG="NURSING"
SET NURSPROG=" NURSING"
+8 SET ^TMP($JOB,NURSFAC,NURSPROG,NPWARD,DA)=""
+9 QUIT
NPRINT ;
+1 SET NURFAC=""
+2 FOR
SET NURFAC=$ORDER(^TMP($JOB,NURFAC))
if NUROUT!(NURFAC="")
QUIT
DO NHDR
if NUROUT
QUIT
SET NURPROG=""
FOR
SET NURPROG=$ORDER(^TMP($JOB,NURFAC,NURPROG))
DO NHDR1
if NUROUT!(NURPROG="")
QUIT
Begin DoDot:1
+3 SET NPWARD=""
FOR
SET NPWARD=$ORDER(^TMP($JOB,NURFAC,NURPROG,NPWARD))
if NPWARD=""!(NUROUT)
QUIT
SET DA=0
FOR
SET DA=$ORDER(^TMP($JOB,NURFAC,NURPROG,NPWARD,DA))
if NUROUT!(DA'>0)
QUIT
DO WRITE
if NUROUT
QUIT
+4 QUIT
End DoDot:1
+5 QUIT
WRITE IF 'NURSW1!($Y>(IOSL-6))
DO NHDR
if NUROUT
QUIT
DO NHDR1
+1 WRITE !,$EXTRACT(NPWARD,1,10)
+2 IF NURSEL'=3
Begin DoDot:1
+3 WRITE ?13,$SELECT($PIECE($GET(^NURSF(211.4,+DA,1)),U)="A":"ACTIVE",1:"INACTIV"),?24,$SELECT($GET(^NURSF(211.4,+DA,"I"))="A":"ACTIVE",1:"**INACTIV")
+4 SET D1=0
FOR
SET D1=$ORDER(^NURSF(211.4,DA,4,D1))
if D1'>0
QUIT
if D1>1
WRITE !
SET Y=+$GET(^NURSF(211.4,DA,4,D1,0))
WRITE ?35,$PIECE($GET(^NURSF(213.3,Y,1)),U)
+5 SET D1=0
FOR
SET D1=$ORDER(^NURSF(211.4,DA,3,D1))
if D1'>0
QUIT
if D1>1
WRITE !
SET X=+$GET(^NURSF(211.4,DA,3,D1,0))
WRITE ?46,$EXTRACT($PIECE($GET(^DIC(42,X,0)),U),1,9)
SET Y=+$PIECE($GET(^NURSF(211.4,DA,3,D1,0)),U,2)
WRITE ?55,$PIECE($GET(^NURSF(213.3,+Y,1)),U)
+6 SET Y=+^NURSF(211.4,DA,0)
WRITE ?66,$SELECT(+$$LOCSTAT^NURSUT1(Y):"YES",1:"NO")
+7 QUIT
End DoDot:1
+8 IF NURS132
Begin DoDot:1
+9 SET NDATA=""
SET NDATA=$GET(^NURSF(211.4,DA,1))
WRITE ?75,$PIECE(NDATA,U,2),?84,$EXTRACT($PIECE($GET(^NURSF(211.5,+$PIECE(NDATA,U,3),0)),U),1,9)
+10 SET NURPOS=+$GET(^NURSF(211.4,DA,0))
SET PDA=0
+11 FOR
SET PDA=$ORDER(^NURSF(211.8,"B",NURPOS,PDA))
if PDA'>0
QUIT
SET NDATA=""
SET NDATA=$GET(^NURSF(211.8,PDA,0))
IF $GET(NDATA)'=""
WRITE ?98,$PIECE(NDATA,U,2),?104,$JUSTIFY($$BUDCAT^NURSUT1(PDA),2,3)
Begin DoDot:2
+12 SET PD1=0
FOR
SET PD1=$ORDER(^NURSF(211.8,PDA,2,PD1))
if PD1'>0
QUIT
SET NDATA=""
SET NDATA=$GET(^NURSF(211.8,PDA,2,PD1,0))
WRITE ?112,$PIECE($GET(^NURSF(211.3,+NDATA,0)),U),?123,$JUSTIFY($PIECE(NDATA,U,2),2,3),!
+13 QUIT
End DoDot:2
WRITE !
IF ($Y>(IOSL-6))
DO NHDR
if NUROUT
QUIT
DO NHDR1
+14 QUIT
End DoDot:1
+15 IF NURSEL=3
Begin DoDot:1
+16 SET NDATA=""
SET NDATA=$GET(^NURSF(211.4,DA,1))
WRITE ?13,$PIECE(NDATA,U,2),?20,$EXTRACT($PIECE($GET(^NURSF(211.5,+$PIECE(NDATA,U,3),0)),U),1,11)
+17 SET NURPOS=+$GET(^NURSF(211.4,DA,0))
SET PDA=0
+18 FOR
SET PDA=$ORDER(^NURSF(211.8,"B",NURPOS,PDA))
if PDA'>0
QUIT
SET NDATA=""
SET NDATA=$GET(^NURSF(211.8,PDA,0))
IF $GET(NDATA)'=""
WRITE ?37,$PIECE(NDATA,U,2),?45,$JUSTIFY($$BUDCAT^NURSUT1(PDA),2,3)
Begin DoDot:2
+19 SET PD1=0
FOR
SET PD1=$ORDER(^NURSF(211.8,PDA,2,PD1))
if PD1'>0
QUIT
SET NDATA=""
SET NDATA=$GET(^NURSF(211.8,PDA,2,PD1,0))
WRITE ?58,$PIECE($GET(^NURSF(211.3,+NDATA,0)),U),?70,$JUSTIFY($PIECE(NDATA,U,2),2,3),!
+20 QUIT
End DoDot:2
WRITE !
IF ($Y>(IOSL-6))
DO NHDR
if NUROUT
QUIT
DO NHDR1
+21 QUIT
End DoDot:1
+22 QUIT
NHDR IF '$GET(NUROUT)
IF 'NURQUEUE
IF NURSW1
IF $EXTRACT(IOST)="C"
DO ENDPG^NURSUT1
if $GET(NUROUT)
QUIT
+1 SET NURPAGE=NURPAGE+1
SET NURSW1=1
+2 if $EXTRACT(IOST)="C"!(NURPAGE>1)
WRITE @IOF
+3 SET X="T"
DO ^%DT
if +Y
DO D^DIQ
SET NURDT=Y
+4 WRITE !,"EXISTING LOCATION REPORT",?$SELECT(NURS132:100,1:50),NURDT,?$SELECT(NURS132:124,1:72),"PAGE: ",NURPAGE
+5 IF '(NURSEL=3)
WRITE !,?13,"PATIENT",?35,"AMIS",?55,"MAS",!,?13,"CARE",?24,"WARD",?35,"BED",?46,"MAS",?55,"BED",?66,"STAFF"
+6 IF +$GET(NURS132)
WRITE ?75,"PROF",?84,"UNIT",?94,"SERVICE",?104,"BUDG",?112,"SERVICE",?123,"BUDG"
+7 IF '(NURSEL=3)
WRITE !,"NAME",?13,"STATUS",?24,"STATUS",?35,"SECTION",?46,"WARD",?55,"SECTION",?66,"FLAG"
+8 IF +$GET(NURS132)
WRITE ?76," %",?84,"TYPE",?94,"CATEGORY",?104,"FTEE",?112,"POSITION",?123,"FTEE"
+9 IF NURSEL=3
Begin DoDot:1
+10 WRITE !,?13,"PROF",?20,"UNIT",?34,"SERVICE",?45,"BUDGETED",?58,"SERVICE",?70,"BUDGETED"
+11 WRITE !,"NAME",?13," %",?20,"TYPE",?34,"CATEGORY",?45,"FTEE",?58,"POSITION",?70,"FTEE"
+12 QUIT
End DoDot:1
+13 WRITE !,$$REPEAT^XLFSTR("-",$SELECT($GET(NURS132):132,1:80))
+14 IF $GET(NURMDSW)
WRITE !!,?10,"FACILITY: ",NURFAC
+15 QUIT
NHDR1 IF $GET(NURPLSW)
IF $GET(NURPROG)'=""
IF $GET(NURPROG)'=" BLANK"
WRITE !?6,"PRODUCT LINE: ",$SELECT($EXTRACT(NURPROG,1)=" ":$EXTRACT(NURPROG,2,99),1:$GET(NURPROG)),!
+1 QUIT
ASK ; ENTRY FOR WARD SELECTION PROMPT
+1 IF $GET(NURMDSW)
SET DIC(0)="AEQZ"
SET NURPLSCR=1
DO EN5^NURSAGSP
KILL NURPLSCR
if $GET(NUROUT)
QUIT
+2 IF '$GET(NURMDSW)
IF $GET(NURPLSW)=1
SET NURPLSCR=1
DO PRD^NURSAGSP
KILL NURPLSCR
if $GET(NUROUT)
QUIT
+3 WRITE !
DO EN1^NURSAGSP
if $GET(NUROUT)
QUIT
+4 QUIT
