NURSAGP0 ;HIRMFO/MD,RM-GENERIC PROMPTS FOR ADMIN/EDUCATION REPORTS ;10/05/95
;;4.0;NURSING SERVICE;**13**;Apr 25, 1997
EN1 ;GENERIC PROMPTS FOR GENDER REPORTS
S NSP=0 W !!,"Select GENDER (Press return for both male and female): " R X:DTIME
I '$T!(X="^") S NUROUT=1 Q
I X="" S NSP=1 Q
S X=$$UP^XLFSTR(X)
I X="M"!(X="F") S NSPC=X Q
W !,?5," Enter One Of The Following : ",!?10," M for Male ",!?10," F for Female " G EN1
EN2 ;GENERIC PROMPTS FOR ACADEMIC DEGREE REPORTS
W ! S NSP=0,DIC("A")="Select ACADEMIC DEGREE (Press return for all degrees): "
S DIC="^NURSF(212.1,",DIC(0)="AEMZQ",DIC("W")="W ?45,$P(^(0),U,3)" D ^DIC W ! I '$D(DTOUT),X="" S NSP=1 Q
I $D(DTOUT)!(X="^")!(+Y'>0) S NUROUT=1 Q
S NSPC=$P(Y(0),"^",3)
Q
EN3 ;GENERIC PROMPTS FOR AGE REPORTS
W ! S X="^",NSP=0,%DT("A")="Start with DATE OF BIRTH (Press return for all dates of birth): ",%DT="AEQ" D ^%DT K %DT I X="" S NSP=1 Q
I X="^"!(+Y'>0) S NUROUT=1 Q
S NSPC=Y
W ! S X="^",NSPC(1)=0,%DT("A")="Go To DATE OF BIRTH (Press return for all dates until the present date): ",%DT="AEQ",X="^" D ^%DT K %DT
I X="" S X="T" D ^%DT S NSPC(1)=Y Q
I Y'>0!(X="^") S NUROUT=1 Q
S NSPC(1)=Y
Q
EN4 ;GENERIC PROMPTS FOR CERTIFICATION REPORTS
W ! S NSP=0 S DIC("A")="Select CERTIFICATION NAME (Press return for all certification names): ",DIC(0)="ZAEMQ",DIC="^NURSF(212.2," D ^DIC I '$D(DTOUT),X="" S NSP=1 G NXCK
I +Y'>0!$D(DTOUT) S NUROUT=1 Q
S NSPC=$P(Y(0),"^",2)
NXCK W ! S X="^",NSP(1)=0,%DT("A")="Start With DATE CERTIFICATION EXPIRES (Press return for all dates): ",%DT="AEQ",X="^" D ^%DT K %DT
I '$D(DTOUT),X="" S NSP(1)=1 Q
I Y'>0!(X="^") S NUROUT=1 Q
S NSPC(1)=Y
W ! S X="^",NSPC(2)=0,%DT("A")="Go To DATE CERTIFICATION EXPIRES (Press return for all dates until present date): ",%DT="AE",X="^" D ^%DT K %DT
I X="" S X="T" D ^%DT S NSPC(2)=Y Q
I Y'>0!(X="^") S NUROUT=1 Q
S NSPC(2)=Y
Q
EN5 ;GENERIC PROMPTS FOR FTEE PROFILE REPORTS
S NSP=0 W !!,"Select FTEE (Press return for all FTEE): " R X:DTIME
I X="^"!'$T S NUROUT=1 Q
I X="" S NSP=1 Q
I X["?" G HELP
I X=+X,X'>1,X'<0,X'?.E1"."4N.N S NSPC=X Q
HELP W !,?5," Type a number between 0 And 1 (e.g. 0,.200,.005,1) " G EN5
EN6 ;GENERIC PROMPTS FOR GRADE PROFILE REPORTS
W ! S NSP=0,DIC("A")="Select GRADE/STEP CODE (Press return for all grade/step codes): "
S DIC="^NURSF(211.1,",DIC(0)="AEMQ" D ^DIC I '$D(DTOUT),X="" S NSP=1 Q
I $D(DTOUT)!(+Y'>0) S NUROUT=1 Q
S NSPC=$P(Y,"^",2)
Q
EN7 ;GENERIC PROMPTS FOR LICENSE PROFILE REPORTS
W ! S X="",NSP=0,%DT("A")="Start With DATE LICENSE EXPIRES (Press return for all dates): ",%DT="AE",X="^" D ^%DT K %DT
I X="" S NSP=1 Q
I Y'>0!(X="^") S NUROUT=1 Q
S NSPC=Y D:+Y D^DIQ S %DT("B")=Y
ENDT W ! S X="",NSPC(2)=0,%DT("A")="Go To DATE LICENSE EXPIRES: ",%DT="AE",X="^" D ^%DT K %DT
I X="" W !!,"PLEASE ENTER A DATE OR '^' TO EXIT" G ENDT
I Y'>0!(X="^") S NUROUT=1 Q
S NSPC(2)=Y
Q
EN8 ;GENERIC PROMPTS FOR MILITARY REPORTS
S NSP=0 W !!,"Select MILITARY STATUS (Press return for retired and active reservists): " R X:DTIME
I '$T!(X="^") S NUROUT=1 Q
I X="" S NSP=1 G NXCK1
S X=$$UP^XLFSTR(X)
I X="A"!(X="R") S NSPC=X G NXCK1
W !,?5," Type A for Active Reservists and Type R for Retired or Discharged) : " G EN8
NXCK1 W ! S NSP(1)=0,DIC("A")="Select MILITARY SERVICE BRANCH (Press return for all service branches) : ",DIC(0)="AEMQ",DIC="^DIC(23," D ^DIC I '$D(DTOUT),X="" S NSP(1)=1 Q
I $D(DTOUT)!(+Y'>0) S NUROUT=1 Q
S NSPC(1)=$P(Y,"^",2)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURSAGP0 3512 printed Dec 13, 2024@02:21:24 Page 2
NURSAGP0 ;HIRMFO/MD,RM-GENERIC PROMPTS FOR ADMIN/EDUCATION REPORTS ;10/05/95
+1 ;;4.0;NURSING SERVICE;**13**;Apr 25, 1997
EN1 ;GENERIC PROMPTS FOR GENDER REPORTS
+1 SET NSP=0
WRITE !!,"Select GENDER (Press return for both male and female): "
READ X:DTIME
+2 IF '$TEST!(X="^")
SET NUROUT=1
QUIT
+3 IF X=""
SET NSP=1
QUIT
+4 SET X=$$UP^XLFSTR(X)
+5 IF X="M"!(X="F")
SET NSPC=X
QUIT
+6 WRITE !,?5," Enter One Of The Following : ",!?10," M for Male ",!?10," F for Female "
GOTO EN1
EN2 ;GENERIC PROMPTS FOR ACADEMIC DEGREE REPORTS
+1 WRITE !
SET NSP=0
SET DIC("A")="Select ACADEMIC DEGREE (Press return for all degrees): "
+2 SET DIC="^NURSF(212.1,"
SET DIC(0)="AEMZQ"
SET DIC("W")="W ?45,$P(^(0),U,3)"
DO ^DIC
WRITE !
IF '$DATA(DTOUT)
IF X=""
SET NSP=1
QUIT
+3 IF $DATA(DTOUT)!(X="^")!(+Y'>0)
SET NUROUT=1
QUIT
+4 SET NSPC=$PIECE(Y(0),"^",3)
+5 QUIT
EN3 ;GENERIC PROMPTS FOR AGE REPORTS
+1 WRITE !
SET X="^"
SET NSP=0
SET %DT("A")="Start with DATE OF BIRTH (Press return for all dates of birth): "
SET %DT="AEQ"
DO ^%DT
KILL %DT
IF X=""
SET NSP=1
QUIT
+2 IF X="^"!(+Y'>0)
SET NUROUT=1
QUIT
+3 SET NSPC=Y
+4 WRITE !
SET X="^"
SET NSPC(1)=0
SET %DT("A")="Go To DATE OF BIRTH (Press return for all dates until the present date): "
SET %DT="AEQ"
SET X="^"
DO ^%DT
KILL %DT
+5 IF X=""
SET X="T"
DO ^%DT
SET NSPC(1)=Y
QUIT
+6 IF Y'>0!(X="^")
SET NUROUT=1
QUIT
+7 SET NSPC(1)=Y
+8 QUIT
EN4 ;GENERIC PROMPTS FOR CERTIFICATION REPORTS
+1 WRITE !
SET NSP=0
SET DIC("A")="Select CERTIFICATION NAME (Press return for all certification names): "
SET DIC(0)="ZAEMQ"
SET DIC="^NURSF(212.2,"
DO ^DIC
IF '$DATA(DTOUT)
IF X=""
SET NSP=1
GOTO NXCK
+2 IF +Y'>0!$DATA(DTOUT)
SET NUROUT=1
QUIT
+3 SET NSPC=$PIECE(Y(0),"^",2)
NXCK WRITE !
SET X="^"
SET NSP(1)=0
SET %DT("A")="Start With DATE CERTIFICATION EXPIRES (Press return for all dates): "
SET %DT="AEQ"
SET X="^"
DO ^%DT
KILL %DT
+1 IF '$DATA(DTOUT)
IF X=""
SET NSP(1)=1
QUIT
+2 IF Y'>0!(X="^")
SET NUROUT=1
QUIT
+3 SET NSPC(1)=Y
+4 WRITE !
SET X="^"
SET NSPC(2)=0
SET %DT("A")="Go To DATE CERTIFICATION EXPIRES (Press return for all dates until present date): "
SET %DT="AE"
SET X="^"
DO ^%DT
KILL %DT
+5 IF X=""
SET X="T"
DO ^%DT
SET NSPC(2)=Y
QUIT
+6 IF Y'>0!(X="^")
SET NUROUT=1
QUIT
+7 SET NSPC(2)=Y
+8 QUIT
EN5 ;GENERIC PROMPTS FOR FTEE PROFILE REPORTS
+1 SET NSP=0
WRITE !!,"Select FTEE (Press return for all FTEE): "
READ X:DTIME
+2 IF X="^"!'$TEST
SET NUROUT=1
QUIT
+3 IF X=""
SET NSP=1
QUIT
+4 IF X["?"
GOTO HELP
+5 IF X=+X
IF X'>1
IF X'<0
IF X'?.E1"."4N.N
SET NSPC=X
QUIT
HELP WRITE !,?5," Type a number between 0 And 1 (e.g. 0,.200,.005,1) "
GOTO EN5
EN6 ;GENERIC PROMPTS FOR GRADE PROFILE REPORTS
+1 WRITE !
SET NSP=0
SET DIC("A")="Select GRADE/STEP CODE (Press return for all grade/step codes): "
+2 SET DIC="^NURSF(211.1,"
SET DIC(0)="AEMQ"
DO ^DIC
IF '$DATA(DTOUT)
IF X=""
SET NSP=1
QUIT
+3 IF $DATA(DTOUT)!(+Y'>0)
SET NUROUT=1
QUIT
+4 SET NSPC=$PIECE(Y,"^",2)
+5 QUIT
EN7 ;GENERIC PROMPTS FOR LICENSE PROFILE REPORTS
+1 WRITE !
SET X=""
SET NSP=0
SET %DT("A")="Start With DATE LICENSE EXPIRES (Press return for all dates): "
SET %DT="AE"
SET X="^"
DO ^%DT
KILL %DT
+2 IF X=""
SET NSP=1
QUIT
+3 IF Y'>0!(X="^")
SET NUROUT=1
QUIT
+4 SET NSPC=Y
if +Y
DO D^DIQ
SET %DT("B")=Y
ENDT WRITE !
SET X=""
SET NSPC(2)=0
SET %DT("A")="Go To DATE LICENSE EXPIRES: "
SET %DT="AE"
SET X="^"
DO ^%DT
KILL %DT
+1 IF X=""
WRITE !!,"PLEASE ENTER A DATE OR '^' TO EXIT"
GOTO ENDT
+2 IF Y'>0!(X="^")
SET NUROUT=1
QUIT
+3 SET NSPC(2)=Y
+4 QUIT
EN8 ;GENERIC PROMPTS FOR MILITARY REPORTS
+1 SET NSP=0
WRITE !!,"Select MILITARY STATUS (Press return for retired and active reservists): "
READ X:DTIME
+2 IF '$TEST!(X="^")
SET NUROUT=1
QUIT
+3 IF X=""
SET NSP=1
GOTO NXCK1
+4 SET X=$$UP^XLFSTR(X)
+5 IF X="A"!(X="R")
SET NSPC=X
GOTO NXCK1
+6 WRITE !,?5," Type A for Active Reservists and Type R for Retired or Discharged) : "
GOTO EN8
NXCK1 WRITE !
SET NSP(1)=0
SET DIC("A")="Select MILITARY SERVICE BRANCH (Press return for all service branches) : "
SET DIC(0)="AEMQ"
SET DIC="^DIC(23,"
DO ^DIC
IF '$DATA(DTOUT)
IF X=""
SET NSP(1)=1
QUIT
+1 IF $DATA(DTOUT)!(+Y'>0)
SET NUROUT=1
QUIT
+2 SET NSPC(1)=$PIECE(Y,"^",2)
+3 QUIT
