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 Dec 13, 2024@02:21:29 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
