NURSAGP1 ;HIRMFO/MD,RM,FT-ADMINISTRATION/EDUCATION REPORT PROMPTS CONTINUED ;2/27/98 14:25
;;4.0;NURSING SERVICE;**1,9**;Apr 25, 1997
EN1 ;GENERIC PROMPTS FOR NSPB REPORTS
W ! S X="^",NSP=0,%DT("A")="Start With ACTION DATE (Press return for all dates): ",%DT="AE" D ^%DT K %DT
I X="" S NSP=1 Q
I Y'>0!(X="^") S NUROUT=1 Q
S NSPC=Y
W ! S X="^",NSPC(2)=0,%DT("A")="Go To ACTION DATE (Press return for all dates until present date): ",%DT="AE" D ^%DT K %DT
I X="" S X="T" D ^%DT S NSPC(2)=Y
I Y'>0!(X="^") S NUROUT=1 Q
S NSPC(2)=Y
Q
EN2 ;GENERIC PROMPTS FOR NURSING EDUCATION PROFILE REPORTS
W ! S NSP=0,DIC("A")="Select NURSING DEGREE (Press return for all nursing degrees): "
S DIC("S")="I $P(^(0),U,1)[""Nursing"""
S DIC="^NURSF(212.1,",DIC(0)="AEMZQ",DIC("W")="W ?45,$P(^(0),U,3)" D ^DIC I '$D(DTOUT),X="" S NSP=1 Q
I $D(DTOUT)!(+Y'>0) S NUROUT=1 Q
S NSPC=$P(Y(0),"^",3)
Q
EN3 ;GENRIC PROMPT FOR INDIVIDUAL REPORTS
W ! S DIC("A")="Select Nursing Staff Name: ",DIC("W")="I $D(^VA(200,+^NURSF(210,+Y,0),1)),$P(^(1),U,9) W ?$X+5,$P(^(1),U,9) S DA=+Y D EN2^NURSUT0 W:$D(NPSPOS) ?$X+5,NPSPOS_"" """
S DIC(0)="AEMQI",DIC="^NURSF(210," D ^DIC K DIC
I "^"[X!'(+Y>0) S NUROUT=1 Q
I '$D(^VA(200,+^NURSF(210,+Y,0),0))!($P(^(0),U)="") W $C(7),!!,"Missing NEW PERSON Name - Cannot Process",! S NUROUT=1 Q
S N1=+Y,N2=$P(Y,"^",2)
Q
EN4 ;GENERIC PROMPTS FOR PROFICIENCY REPORTS
W ! S X="^",NSP=0,%DT("A")="Select DUE DATE (Press return for all dates): ",%DT="AE" 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
W ! S X="^",NSPC(2)=0,%DT(0)=NSPC,%DT("A")="Go To DUE DATE: ",%DT="AE" 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 NURSING EDUCATION PROFILE REPORTS
S NURSER=$$GETSER^NURSUT3 I $G(NURSER)="" W !!,$C(7),"NO NURSING SERVICE ENTRY IN COST CENTER/ORGANIZATION CODE FILE 454.1 CANNOT-CONTINUE: " Q
I $G(NURSEL)="A" Q
N Y K DTOUT,DUOUT W !
S DIC("S")="S DAT=$G(^(0)),NURCLAS=$P($G(DAT),U,2),NURIEN=$G(^PRSE(452,""AK"",NURCLAS,Y)),NURD0=$O(^PRSE(452.1,""B"",NURCLAS,0)) I $P(DAT,U,21)=NURSEL,(NURSER[(U_NURIEN_U)!($P($G(^PRSE(452.1,+NURD0,0)),U,9)=0))"
S NSP=0,NURSCLS="",DIC("A")="Select TRAINING CLASS (Press return for all classes): "
S D="AK",DIC="^PRSE(452,",DIC(0)="ASQZE" D IX^DIC K DIC
I '$D(DTOUT),'$D(DUOUT),X="" S NSP=1 Q
I $D(DTOUT)!($D(DUOUT))!(+Y'>0) S NUROUT=1 Q
S (NURSCLS,NSPC)=$P($G(Y(0)),U,2),NURSCLS(0)=+$O(^PRSE(452.1,"B",NSPC,0))
Q
EN3A ; ENTRY POINT FOR CLASS DATE
W ! S X="^",NSP(1)=0,%DT("A")="Start With CLASS DATE (Press return for all dates): ",%DT="AE",%DT(0)=-DT D ^%DT K %DT
I 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 CLASS DATE (Press return for all dates until present date): ",%DT="AE" 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
EN6 ; FISCAL YEAR SELECTION ROUTINE
W !,"Select Year: " R X:DTIME I '$T!("^"[X) S NUROUT=1 Q
S YR=1700+$E(DT,1,3) S YR(1)=YR-1,YR(2)=YR-2
I X["?"!'(X?4N) D YRHELP G EN6
S NYR=X I NYR>YR!(NYR<(YR(2))) D YRHELP G EN6
S %DT="",X="10/1/"_(NYR-1) D ^%DT S FY=+Y,%DT="",X="9/30/"_NYR D ^%DT S FYEND=+Y
Q
YRHELP W !!,$C(7),"Enter a year designating one of the last three fiscal years (",YR,",",YR(1),",",YR(2),"):",!
Q
EN7 ; DATE RANGE ENTRY POINT
W ! S X="T-1" D ^%DT S NDATE(1)=+Y,DIR(0)="DOA^:"_NDATE(1)_":EX",DIR("A")="Start with DATE: ",DIR("?")="^S %DT(0)=-NDATE(1) D HELP^%DTC" D ^DIR K DIR I $G(DIRUT) S NUROUT=1 Q
S $P(NDATED,U)=+Y,X1=+NDATED,X2=+31 D C^%DTC S (NDATE,Y)=X S NDATE(1)=$S(NDATE>NDATE(1):NDATE(1),1:NDATE),Y=+NDATED D D^DIQ S NURDFLT1=Y,Y=+NDATE(1) D D^DIQ S NURDFLT2=Y
W ! S DIR(0)="DOA^"_+NDATED_":"_+NDATE(1)_":EX",DIR("A")="Go to DATE: ",DIR("?")="^D HELP^%DTC W !!,?5,""Enter a date between ""_NURDFLT1_"" and ""_NURDFLT2_"".""" S:$G(NURDFLT1)'="" DIR("B")=NURDFLT1 D ^DIR K DIR
I $G(DIRUT) S NUROUT=1 Q
S $P(NDATED,U,2)=+Y
Q
EN8 ; NON RESTRICTED DATE RANGE ENTRY POINT
W ! S DIR(0)="DO^::EX",DIR("A")="Start with DATE",DIR("?")="^D HELP^%DTC" D ^DIR K DIR I $G(DIRUT) S NUROUT=1 Q
S $P(NDATED,U)=+Y S X1=+NDATED,X2=+31 D C^%DTC S (NDATE,Y)=X D D^DIQ S NDATE(2)=Y S Y=+NDATED D D^DIQ S NDATE(1)=Y
W ! S DIR(0)="DOA^"_+NDATED_":"_+NDATE_":EX",DIR("A")="Go to DATE: ",DIR("?")="^D HELP^%DTC W !!,?5,""Enter a date between ""_NDATE(1)_"" and ""_NDATE(2)_"".""" S:$G(NDATE(1))'="" DIR("B")=NDATE(1) D ^DIR K DIR I $G(DIRUT) S NUROUT=1 Q
S $P(NDATED,U,2)=+Y
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURSAGP1 4597 printed Dec 13, 2024@02:21:25 Page 2
NURSAGP1 ;HIRMFO/MD,RM,FT-ADMINISTRATION/EDUCATION REPORT PROMPTS CONTINUED ;2/27/98 14:25
+1 ;;4.0;NURSING SERVICE;**1,9**;Apr 25, 1997
EN1 ;GENERIC PROMPTS FOR NSPB REPORTS
+1 WRITE !
SET X="^"
SET NSP=0
SET %DT("A")="Start With ACTION DATE (Press return for all dates): "
SET %DT="AE"
DO ^%DT
KILL %DT
+2 IF X=""
SET NSP=1
QUIT
+3 IF Y'>0!(X="^")
SET NUROUT=1
QUIT
+4 SET NSPC=Y
+5 WRITE !
SET X="^"
SET NSPC(2)=0
SET %DT("A")="Go To ACTION DATE (Press return for all dates until present date): "
SET %DT="AE"
DO ^%DT
KILL %DT
+6 IF X=""
SET X="T"
DO ^%DT
SET NSPC(2)=Y
+7 IF Y'>0!(X="^")
SET NUROUT=1
QUIT
+8 SET NSPC(2)=Y
+9 QUIT
EN2 ;GENERIC PROMPTS FOR NURSING EDUCATION PROFILE REPORTS
+1 WRITE !
SET NSP=0
SET DIC("A")="Select NURSING DEGREE (Press return for all nursing degrees): "
+2 SET DIC("S")="I $P(^(0),U,1)[""Nursing"""
+3 SET DIC="^NURSF(212.1,"
SET DIC(0)="AEMZQ"
SET DIC("W")="W ?45,$P(^(0),U,3)"
DO ^DIC
IF '$DATA(DTOUT)
IF X=""
SET NSP=1
QUIT
+4 IF $DATA(DTOUT)!(+Y'>0)
SET NUROUT=1
QUIT
+5 SET NSPC=$PIECE(Y(0),"^",3)
+6 QUIT
EN3 ;GENRIC PROMPT FOR INDIVIDUAL REPORTS
+1 WRITE !
SET DIC("A")="Select Nursing Staff Name: "
SET DIC("W")="I $D(^VA(200,+^NURSF(210,+Y,0),1)),$P(^(1),U,9) W ?$X+5,$P(^(1),U,9) S DA=+Y D EN2^NURSUT0 W:$D(NPSPOS) ?$X+5,NPSPOS_"" """
+2 SET DIC(0)="AEMQI"
SET DIC="^NURSF(210,"
DO ^DIC
KILL DIC
+3 IF "^"[X!'(+Y>0)
SET NUROUT=1
QUIT
+4 IF '$DATA(^VA(200,+^NURSF(210,+Y,0),0))!($PIECE(^(0),U)="")
WRITE $CHAR(7),!!,"Missing NEW PERSON Name - Cannot Process",!
SET NUROUT=1
QUIT
+5 SET N1=+Y
SET N2=$PIECE(Y,"^",2)
+6 QUIT
EN4 ;GENERIC PROMPTS FOR PROFICIENCY REPORTS
+1 WRITE !
SET X="^"
SET NSP=0
SET %DT("A")="Select DUE DATE (Press return for all dates): "
SET %DT="AE"
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
+5 WRITE !
SET X="^"
SET NSPC(2)=0
SET %DT(0)=NSPC
SET %DT("A")="Go To DUE DATE: "
SET %DT="AE"
DO ^%DT
KILL %DT
+6 IF X=""
SET X="T"
DO ^%DT
SET NSPC(2)=Y
QUIT
+7 IF Y'>0!(X="^")
SET NUROUT=1
QUIT
+8 SET NSPC(2)=Y
+9 QUIT
EN5 ;GENERIC PROMPTS FOR NURSING EDUCATION PROFILE REPORTS
+1 SET NURSER=$$GETSER^NURSUT3
IF $GET(NURSER)=""
WRITE !!,$CHAR(7),"NO NURSING SERVICE ENTRY IN COST CENTER/ORGANIZATION CODE FILE 454.1 CANNOT-CONTINUE: "
QUIT
+2 IF $GET(NURSEL)="A"
QUIT
+3 NEW Y
KILL DTOUT,DUOUT
WRITE !
+4 SET DIC("S")="S DAT=$G(^(0)),NURCLAS=$P($G(DAT),U,2),NURIEN=$G(^PRSE(452,""AK"",NURCLAS,Y)),NURD0=$O(^PRSE(452.1,""B"",NURCLAS,0)) I $P(DAT,U,21)=NURSEL,(NURSER[(U_NURIEN_U)!($P($G(^PRSE(452.1,+NURD0,0)),U,9)=0))"
+5 SET NSP=0
SET NURSCLS=""
SET DIC("A")="Select TRAINING CLASS (Press return for all classes): "
+6 SET D="AK"
SET DIC="^PRSE(452,"
SET DIC(0)="ASQZE"
DO IX^DIC
KILL DIC
+7 IF '$DATA(DTOUT)
IF '$DATA(DUOUT)
IF X=""
SET NSP=1
QUIT
+8 IF $DATA(DTOUT)!($DATA(DUOUT))!(+Y'>0)
SET NUROUT=1
QUIT
+9 SET (NURSCLS,NSPC)=$PIECE($GET(Y(0)),U,2)
SET NURSCLS(0)=+$ORDER(^PRSE(452.1,"B",NSPC,0))
+10 QUIT
EN3A ; ENTRY POINT FOR CLASS DATE
+1 WRITE !
SET X="^"
SET NSP(1)=0
SET %DT("A")="Start With CLASS DATE (Press return for all dates): "
SET %DT="AE"
SET %DT(0)=-DT
DO ^%DT
KILL %DT
+2 IF X=""
SET NSP(1)=1
QUIT
+3 IF Y'>0!(X="^")
SET NUROUT=1
QUIT
+4 SET NSPC(1)=Y
+5 WRITE !
SET X="^"
SET NSPC(2)=0
SET %DT("A")="Go To CLASS DATE (Press return for all dates until present date): "
SET %DT="AE"
DO ^%DT
KILL %DT
+6 IF X=""
SET X="T"
DO ^%DT
SET NSPC(2)=Y
QUIT
+7 IF Y'>0!(X="^")
SET NUROUT=1
QUIT
+8 SET NSPC(2)=Y
+9 QUIT
EN6 ; FISCAL YEAR SELECTION ROUTINE
+1 WRITE !,"Select Year: "
READ X:DTIME
IF '$TEST!("^"[X)
SET NUROUT=1
QUIT
+2 SET YR=1700+$EXTRACT(DT,1,3)
SET YR(1)=YR-1
SET YR(2)=YR-2
+3 IF X["?"!'(X?4N)
DO YRHELP
GOTO EN6
+4 SET NYR=X
IF NYR>YR!(NYR<(YR(2)))
DO YRHELP
GOTO EN6
+5 SET %DT=""
SET X="10/1/"_(NYR-1)
DO ^%DT
SET FY=+Y
SET %DT=""
SET X="9/30/"_NYR
DO ^%DT
SET FYEND=+Y
+6 QUIT
YRHELP WRITE !!,$CHAR(7),"Enter a year designating one of the last three fiscal years (",YR,",",YR(1),",",YR(2),"):",!
+1 QUIT
EN7 ; DATE RANGE ENTRY POINT
+1 WRITE !
SET X="T-1"
DO ^%DT
SET NDATE(1)=+Y
SET DIR(0)="DOA^:"_NDATE(1)_":EX"
SET DIR("A")="Start with DATE: "
SET DIR("?")="^S %DT(0)=-NDATE(1) D HELP^%DTC"
DO ^DIR
KILL DIR
IF $GET(DIRUT)
SET NUROUT=1
QUIT
+2 SET $PIECE(NDATED,U)=+Y
SET X1=+NDATED
SET X2=+31
DO C^%DTC
SET (NDATE,Y)=X
SET NDATE(1)=$SELECT(NDATE>NDATE(1):NDATE(1),1:NDATE)
SET Y=+NDATED
DO D^DIQ
SET NURDFLT1=Y
SET Y=+NDATE(1)
DO D^DIQ
SET NURDFLT2=Y
+3 WRITE !
SET DIR(0)="DOA^"_+NDATED_":"_+NDATE(1)_":EX"
SET DIR("A")="Go to DATE: "
SET DIR("?")="^D HELP^%DTC W !!,?5,""Enter a date between ""_NURDFLT1_"" and ""_NURDFLT2_""."""
if $GET(NURDFLT1)'=""
SET DIR("B")=NURDFLT1
DO ^DIR
KILL DIR
+4 IF $GET(DIRUT)
SET NUROUT=1
QUIT
+5 SET $PIECE(NDATED,U,2)=+Y
+6 QUIT
EN8 ; NON RESTRICTED DATE RANGE ENTRY POINT
+1 WRITE !
SET DIR(0)="DO^::EX"
SET DIR("A")="Start with DATE"
SET DIR("?")="^D HELP^%DTC"
DO ^DIR
KILL DIR
IF $GET(DIRUT)
SET NUROUT=1
QUIT
+2 SET $PIECE(NDATED,U)=+Y
SET X1=+NDATED
SET X2=+31
DO C^%DTC
SET (NDATE,Y)=X
DO D^DIQ
SET NDATE(2)=Y
SET Y=+NDATED
DO D^DIQ
SET NDATE(1)=Y
+3 WRITE !
SET DIR(0)="DOA^"_+NDATED_":"_+NDATE_":EX"
SET DIR("A")="Go to DATE: "
SET DIR("?")="^D HELP^%DTC W !!,?5,""Enter a date between ""_NDATE(1)_"" and ""_NDATE(2)_""."""
if $GET(NDATE(1))'=""
SET DIR("B")=NDATE(1)
DO ^DIR
KILL DIR
IF $GET(DIRUT)
SET NUROUT=1
QUIT
+4 SET $PIECE(NDATED,U,2)=+Y
+5 QUIT
