- NURSAGSP ;HIRMFO/MD-GENERIC SORT BY PROMPTS ;7/24/97
- ;;4.0;NURSING SERVICE;**3**;Apr 25, 1997
- ; ROUTINE THAT GIVES VARIOUS SORT BY PROMPTS FOR ADMIN REPORTS.
- ;
- EN1 ; ENTRY FOR WARD SELECTION PROMPT
- S NURSZ=$$MDIC^NURSAGS0
- I NURSZ'>0 S NUROUT=1 Q
- Q
- EN2 ; ENTRY FOR SERVICE POSITION PROMPT
- S NURSER=0,DIC("A")="Select SERVICE POSITION (Press return for all service positions): " S:$D(NRNS) DIC("S")="I $P(^(0),U,5)=""R"""
- S DIC="^NURSF(211.3,",DIC(0)="AEMQ" D ^DIC K DIC I '$D(DTOUT),X="" S NURSER=1 Q
- I $D(DTOUT)!(+Y'>0) S NUROUT=1 Q
- S NPOS=$P(Y,"^",1)
- Q
- EN3 ; ENTRY FOR SERVICE CATEGORY PROMPT
- W ! S NURCAT=0 D EN1^NURSAGP3 I $G(DUOUT)!($G(DTOUT)) S NUROUT=1 Q
- S ZTSAVE("^TMP(""NURSCAT"",$J,")=""
- Q
- EN5 ; ENTRY FOR FACILITY/SERVICE SELECTION WITH AUTHORIZATION CHECKS
- ; IF THE USER HOLDS AN AMIS POSITION OF HEAD NURSE OR LOWER
- ; THEY CAN ONLY SEE DATA ASSOCIATED WITH THEIR FACILITY(IES)
- W ! S DIC=213.2,DIC("A")="Select FACILITY"_$S(NURSZAP'>7!('NURSZAP):" (Press return for "_$S(NURSZAP'=7:"all facilities",1:"your facilities")_")",1:"")_": "
- I NURSZAP S:NURSZAP>6 DIC("S")="S YY=+^NURSA(213.2,Y,0) I $D(NURSZFAC($P(^DIC(4,+YY,0),U)))" I NURSZAP>7 S NURFAC("D")=$O(NURSZFAC("")) K DIC("B") S:NURFAC("D")'="" DIC("B")=NURFAC("D")
- S NURFAC=0,DIC="^NURSA(213.2,",DIC(0)="AEQZ" D ^DIC K DIC I '$D(DTOUT),$G(X)="" S NURFAC=1 G PRD
- I '$D(DTOUT),$G(X)="" W:NURSZAP<6 !,$C(7),?5,"PROPER ACCESS REQUIRED TO PRINT ALL LOCATIONS" G:NURSZAP>6 EN5 S NURFAC=1 Q
- I $D(DTOUT)!(+Y'>0) S NUROUT=1 Q
- S NURFAC(1)=$G(Y(0,0))
- PRD I $G(NURPLSW) W ! D EN6^NURSAGSP
- Q
- EN6 ; ENTRY FOR PRODUCT LINE PROMPT
- S DIC("A")="Select PRODUCT LINE (Press return for all product lines): "
- S NURPROG=0,DIC="^NURSF(212.7,",DIC(0)="AEMQZ"
- I "^0^1^"[("^"_$G(NURPLSCR)_"^") S DIC("S")="I $D(^NURSF("_$S(NURPLSCR:211.4,1:211.3)_",""P"",Y))"
- D ^DIC K DIC I '$D(DTOUT),X="" S NURPROG=1 Q
- I $D(DTOUT)!(+Y'>0) S NUROUT=1 Q
- S NURPROG(1)=Y(0,0)
- Q
- EN8 ; ENTRY FOR BASIC FACILITY SELECTION WITH NO AUTHORIZATION CHECKS
- Q:$P($G(^DIC(213.9,1,0)),U,9)'="Y"
- S DIC("A")="Select FACILITY (Press return for all facilities): "
- S NURFAC=0,DIC="^NURSA(213.2," D ^DIC K DIC I '$D(DTOUT),$G(X)="" S NURFAC=1 Q
- I $D(DTOUT)!(+Y'>0) S NUROUT=1 Q
- S NURFAC(1)=$G(Y(0,0))
- Q
- EN9 ; CONSOLIDATED FACILITY/MULTIPLE PROGRAM OFFICE CHECKS
- I $D(NURMDSW),$P($G(^DIC(213.9,1,0)),U,9)="Y" S NURMDSW=1
- I $D(NURPLSW),$P($G(^DIC(213.9,1,0)),U,8)="Y" S NURPLSW=1
- Q
- EN10 ; STATE FILE LOOK-UP
- K NSTAT S NSTAT=0,DIC("A")="Select STATE (Press return for all states): ",DIC(0)="AEQMZ",DIC="^DIC(5," D ^DIC K DIC I '$D(DTOUT),X="" S NSTAT=1 Q
- I $D(DTOUT)!(+Y'>0) S NUROUT=1 Q
- S NSTAT(1)=+Y
- Q
- EN11 ; Summary/Full report selection
- S DIR("A")="Select Reporting Option: ",DIR("A",1)="",DIR("A",2)="1. Summary Report",DIR("A",3)="",DIR("A",4)="2. Full Report.",DIR("A",5)="",DIR(0)="NA^1:2" D ^DIR K DIR I $G(DIRUT) S NUROUT=1 Q
- I X=1 S NURSUMSW=1
- Q
- EN12 ; Multi-Divisional Summary/Full report selection
- S DIR("A")="Select Reporting Option: ",DIR("A",1)="",DIR("A",2)="1. Multi-Divisional Summary Report.",DIR("A",3)="",DIR("A",4)="2. Detailed Multi-Divisional Report.",DIR("A",5)="",DIR(0)="NA^1:2" D ^DIR K DIR I $G(DIRUT) S NUROUT=1 Q
- I X=1 S NURSUMSW=1
- Q
- EN13 ; Location/Service Category sort selection
- S DIR("A")="Sort By: ",DIR("A",1)="",DIR("A",2)="1. Unit",DIR("A",3)="",DIR("A",4)="2. Service Category",DIR("A",5)="",DIR(0)="NA^1:2" D ^DIR K DIR I $G(DIRUT) S NUROUT=1
- S NURSEL(1)=X
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURSAGSP 3519 printed Jan 18, 2025@03:22:39 Page 2
- NURSAGSP ;HIRMFO/MD-GENERIC SORT BY PROMPTS ;7/24/97
- +1 ;;4.0;NURSING SERVICE;**3**;Apr 25, 1997
- +2 ; ROUTINE THAT GIVES VARIOUS SORT BY PROMPTS FOR ADMIN REPORTS.
- +3 ;
- EN1 ; ENTRY FOR WARD SELECTION PROMPT
- +1 SET NURSZ=$$MDIC^NURSAGS0
- +2 IF NURSZ'>0
- SET NUROUT=1
- QUIT
- +3 QUIT
- EN2 ; ENTRY FOR SERVICE POSITION PROMPT
- +1 SET NURSER=0
- SET DIC("A")="Select SERVICE POSITION (Press return for all service positions): "
- if $DATA(NRNS)
- SET DIC("S")="I $P(^(0),U,5)=""R"""
- +2 SET DIC="^NURSF(211.3,"
- SET DIC(0)="AEMQ"
- DO ^DIC
- KILL DIC
- IF '$DATA(DTOUT)
- IF X=""
- SET NURSER=1
- QUIT
- +3 IF $DATA(DTOUT)!(+Y'>0)
- SET NUROUT=1
- QUIT
- +4 SET NPOS=$PIECE(Y,"^",1)
- +5 QUIT
- EN3 ; ENTRY FOR SERVICE CATEGORY PROMPT
- +1 WRITE !
- SET NURCAT=0
- DO EN1^NURSAGP3
- IF $GET(DUOUT)!($GET(DTOUT))
- SET NUROUT=1
- QUIT
- +2 SET ZTSAVE("^TMP(""NURSCAT"",$J,")=""
- +3 QUIT
- EN5 ; ENTRY FOR FACILITY/SERVICE SELECTION WITH AUTHORIZATION CHECKS
- +1 ; IF THE USER HOLDS AN AMIS POSITION OF HEAD NURSE OR LOWER
- +2 ; THEY CAN ONLY SEE DATA ASSOCIATED WITH THEIR FACILITY(IES)
- +3 WRITE !
- SET DIC=213.2
- SET DIC("A")="Select FACILITY"_$SELECT(NURSZAP'>7!('NURSZAP):" (Press return for "_$SELECT(NURSZAP'=7:"all facilities",1:"your facilities")_")",1:"")_": "
- +4 IF NURSZAP
- if NURSZAP>6
- SET DIC("S")="S YY=+^NURSA(213.2,Y,0) I $D(NURSZFAC($P(^DIC(4,+YY,0),U)))"
- IF NURSZAP>7
- SET NURFAC("D")=$ORDER(NURSZFAC(""))
- KILL DIC("B")
- if NURFAC("D")'=""
- SET DIC("B")=NURFAC("D")
- +5 SET NURFAC=0
- SET DIC="^NURSA(213.2,"
- SET DIC(0)="AEQZ"
- DO ^DIC
- KILL DIC
- IF '$DATA(DTOUT)
- IF $GET(X)=""
- SET NURFAC=1
- GOTO PRD
- +6 IF '$DATA(DTOUT)
- IF $GET(X)=""
- if NURSZAP<6
- WRITE !,$CHAR(7),?5,"PROPER ACCESS REQUIRED TO PRINT ALL LOCATIONS"
- if NURSZAP>6
- GOTO EN5
- SET NURFAC=1
- QUIT
- +7 IF $DATA(DTOUT)!(+Y'>0)
- SET NUROUT=1
- QUIT
- +8 SET NURFAC(1)=$GET(Y(0,0))
- PRD IF $GET(NURPLSW)
- WRITE !
- DO EN6^NURSAGSP
- +1 QUIT
- EN6 ; ENTRY FOR PRODUCT LINE PROMPT
- +1 SET DIC("A")="Select PRODUCT LINE (Press return for all product lines): "
- +2 SET NURPROG=0
- SET DIC="^NURSF(212.7,"
- SET DIC(0)="AEMQZ"
- +3 IF "^0^1^"[("^"_$GET(NURPLSCR)_"^")
- SET DIC("S")="I $D(^NURSF("_$SELECT(NURPLSCR:211.4,1:211.3)_",""P"",Y))"
- +4 DO ^DIC
- KILL DIC
- IF '$DATA(DTOUT)
- IF X=""
- SET NURPROG=1
- QUIT
- +5 IF $DATA(DTOUT)!(+Y'>0)
- SET NUROUT=1
- QUIT
- +6 SET NURPROG(1)=Y(0,0)
- +7 QUIT
- EN8 ; ENTRY FOR BASIC FACILITY SELECTION WITH NO AUTHORIZATION CHECKS
- +1 if $PIECE($GET(^DIC(213.9,1,0)),U,9)'="Y"
- QUIT
- +2 SET DIC("A")="Select FACILITY (Press return for all facilities): "
- +3 SET NURFAC=0
- SET DIC="^NURSA(213.2,"
- DO ^DIC
- KILL DIC
- IF '$DATA(DTOUT)
- IF $GET(X)=""
- SET NURFAC=1
- QUIT
- +4 IF $DATA(DTOUT)!(+Y'>0)
- SET NUROUT=1
- QUIT
- +5 SET NURFAC(1)=$GET(Y(0,0))
- +6 QUIT
- EN9 ; CONSOLIDATED FACILITY/MULTIPLE PROGRAM OFFICE CHECKS
- +1 IF $DATA(NURMDSW)
- IF $PIECE($GET(^DIC(213.9,1,0)),U,9)="Y"
- SET NURMDSW=1
- +2 IF $DATA(NURPLSW)
- IF $PIECE($GET(^DIC(213.9,1,0)),U,8)="Y"
- SET NURPLSW=1
- +3 QUIT
- EN10 ; STATE FILE LOOK-UP
- +1 KILL NSTAT
- SET NSTAT=0
- SET DIC("A")="Select STATE (Press return for all states): "
- SET DIC(0)="AEQMZ"
- SET DIC="^DIC(5,"
- DO ^DIC
- KILL DIC
- IF '$DATA(DTOUT)
- IF X=""
- SET NSTAT=1
- QUIT
- +2 IF $DATA(DTOUT)!(+Y'>0)
- SET NUROUT=1
- QUIT
- +3 SET NSTAT(1)=+Y
- +4 QUIT
- EN11 ; Summary/Full report selection
- +1 SET DIR("A")="Select Reporting Option: "
- SET DIR("A",1)=""
- SET DIR("A",2)="1. Summary Report"
- SET DIR("A",3)=""
- SET DIR("A",4)="2. Full Report."
- SET DIR("A",5)=""
- SET DIR(0)="NA^1:2"
- DO ^DIR
- KILL DIR
- IF $GET(DIRUT)
- SET NUROUT=1
- QUIT
- +2 IF X=1
- SET NURSUMSW=1
- +3 QUIT
- EN12 ; Multi-Divisional Summary/Full report selection
- +1 SET DIR("A")="Select Reporting Option: "
- SET DIR("A",1)=""
- SET DIR("A",2)="1. Multi-Divisional Summary Report."
- SET DIR("A",3)=""
- SET DIR("A",4)="2. Detailed Multi-Divisional Report."
- SET DIR("A",5)=""
- SET DIR(0)="NA^1:2"
- DO ^DIR
- KILL DIR
- IF $GET(DIRUT)
- SET NUROUT=1
- QUIT
- +2 IF X=1
- SET NURSUMSW=1
- +3 QUIT
- EN13 ; Location/Service Category sort selection
- +1 SET DIR("A")="Sort By: "
- SET DIR("A",1)=""
- SET DIR("A",2)="1. Unit"
- SET DIR("A",3)=""
- SET DIR("A",4)="2. Service Category"
- SET DIR("A",5)=""
- SET DIR(0)="NA^1:2"
- DO ^DIR
- KILL DIR
- IF $GET(DIRUT)
- SET NUROUT=1
- +2 SET NURSEL(1)=X
- +3 QUIT