- 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 Feb 18, 2025@23:47:55 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