- 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 Jan 18, 2025@03:22:36 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