- NURARPC1 ;HIRMFO/RM/MD-PRINT AMIS 1106 ACUITY REPORTS (cont.) ;2/27/98 14:38
- ;;4.0;NURSING SERVICE;**9,13**;Apr 25, 1997
- SETDAY ; SET DAY IF DAILY REPORT
- D EN7^NURSAGP1 Q:NUROUT
- Q
- SETMON ; SET MONTH IF MONTHLY REPORT
- W !!,"Enter MONTH and CALENDER YEAR: "
- R X:DTIME
- I '$T!("^"[X) S NUROUT=1 Q
- S %DT="E" D ^%DT K %DT
- G:((X["?")) SETMON
- S X=Y D H^%DTC I ((%Y'=-1)!($E(Y,6,7)'="00")!($E(Y,4,5)="00")) W $C(7),!!,"Only enter a MONTH and YEAR eg. '3/1998 or MAR, 1998' " G SETMON
- S NDATED=$E(Y,1,5)_"MT"
- S:'$D(NURTYPE) NURTYPE=0 S NURSHDR=$S(NURTYPE=0:"AMIS ",1:"Midnight Acuity ")_"Monthly Report for "_$E(NDATED,4,5)_"/"_$E(NDATED,2,3)
- Q
- SETQUART ; SET QUARTER IF QUARTERLY REPORT
- W ! S %DT="AE",%DT("A")="Enter FISCAL YEAR: "
- D ^%DT K %DT
- I X="^" S NUROUT=1 Q
- G:((Y<0)!(X["?")) SETQUART
- S X=Y D H^%DTC I ((%Y'=-1)!($E(Y,4,5)'="00")) W *7,!!,"Only enter a YEAR" G SETQUART
- K %Y S NDATED=$E(Y,1,3) S:'$D(NURTYPE) NURTYPE=0
- I NURSWHEN["A" S NURSHDR=$S(NURTYPE=0:"AMIS ",1:"Midnight Acuity ")_"Annual Report for "_(1700+$E(NDATED,1,3)) Q
- SETQUAR1 ;
- W !!,"Enter QUARTER (Choose a number 1-4): "
- R X:DTIME
- I X="^"!'$T S NUROUT=1 Q
- I ((X'?1N)!(X<1)!(X>4)) W $C(7) G SETQUAR1
- S NDATED=$S(X=1:NDATED_"12Q1",X=2:NDATED_"03Q2",X=3:NDATED_"06Q3",X=4:NDATED_"09Q4",1:0)
- I NDATED=0 W *7,!!!,"INVALID ENTRY, TRY AGAIN" G SETQUART
- S:'$D(NURTYPE) NURTYPE=0 S NURSHDR=$S(NURTYPE=0:"AMIS ",1:"Midnight Acuity ")_"Quarterly Report for "_(1700+$E(NDATED,1,3))_" Qtr. #"_$E(NDATED,7)
- Q
- NOVALU(NDA) ;
- ; This function checks inactive units to see if they have acuity
- ; data for the requested reporting period. If a unit has acuity
- ; data a one (1) is returned otherwise a zero (0) is returned,
- N NURX S NURX=1,NUNIT=$E($P($G(^NURSA(213.4,NDA,0)),U),9,99)
- I $G(^NURSF(211.4,+NUNIT,"I"))="I" D
- . S D1=0 F S D1=$O(^NURSA(213.4,NDA,1,D1)) Q:D1'>0 D:$G(^NURSA(213.4,NDA,1,D1,0))'=""
- . . I $P(^NURSA(213.4,NDA,1,D1,0),U,2,6)="0^0^0^0^0" S NURX=0
- . . Q
- . Q
- K NUNIT
- Q NURX
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURARPC1 2030 printed Feb 18, 2025@23:46:16 Page 2
- NURARPC1 ;HIRMFO/RM/MD-PRINT AMIS 1106 ACUITY REPORTS (cont.) ;2/27/98 14:38
- +1 ;;4.0;NURSING SERVICE;**9,13**;Apr 25, 1997
- SETDAY ; SET DAY IF DAILY REPORT
- +1 DO EN7^NURSAGP1
- if NUROUT
- QUIT
- +2 QUIT
- SETMON ; SET MONTH IF MONTHLY REPORT
- +1 WRITE !!,"Enter MONTH and CALENDER YEAR: "
- +2 READ X:DTIME
- +3 IF '$TEST!("^"[X)
- SET NUROUT=1
- QUIT
- +4 SET %DT="E"
- DO ^%DT
- KILL %DT
- +5 if ((X["?"))
- GOTO SETMON
- +6 SET X=Y
- DO H^%DTC
- IF ((%Y'=-1)!($EXTRACT(Y,6,7)'="00")!($EXTRACT(Y,4,5)="00"))
- WRITE $CHAR(7),!!,"Only enter a MONTH and YEAR eg. '3/1998 or MAR, 1998' "
- GOTO SETMON
- +7 SET NDATED=$EXTRACT(Y,1,5)_"MT"
- +8 if '$DATA(NURTYPE)
- SET NURTYPE=0
- SET NURSHDR=$SELECT(NURTYPE=0:"AMIS ",1:"Midnight Acuity ")_"Monthly Report for "_$EXTRACT(NDATED,4,5)_"/"_$EXTRACT(NDATED,2,3)
- +9 QUIT
- SETQUART ; SET QUARTER IF QUARTERLY REPORT
- +1 WRITE !
- SET %DT="AE"
- SET %DT("A")="Enter FISCAL YEAR: "
- +2 DO ^%DT
- KILL %DT
- +3 IF X="^"
- SET NUROUT=1
- QUIT
- +4 if ((Y<0)!(X["?"))
- GOTO SETQUART
- +5 SET X=Y
- DO H^%DTC
- IF ((%Y'=-1)!($EXTRACT(Y,4,5)'="00"))
- WRITE *7,!!,"Only enter a YEAR"
- GOTO SETQUART
- +6 KILL %Y
- SET NDATED=$EXTRACT(Y,1,3)
- if '$DATA(NURTYPE)
- SET NURTYPE=0
- +7 IF NURSWHEN["A"
- SET NURSHDR=$SELECT(NURTYPE=0:"AMIS ",1:"Midnight Acuity ")_"Annual Report for "_(1700+$EXTRACT(NDATED,1,3))
- QUIT
- SETQUAR1 ;
- +1 WRITE !!,"Enter QUARTER (Choose a number 1-4): "
- +2 READ X:DTIME
- +3 IF X="^"!'$TEST
- SET NUROUT=1
- QUIT
- +4 IF ((X'?1N)!(X<1)!(X>4))
- WRITE $CHAR(7)
- GOTO SETQUAR1
- +5 SET NDATED=$SELECT(X=1:NDATED_"12Q1",X=2:NDATED_"03Q2",X=3:NDATED_"06Q3",X=4:NDATED_"09Q4",1:0)
- +6 IF NDATED=0
- WRITE *7,!!!,"INVALID ENTRY, TRY AGAIN"
- GOTO SETQUART
- +7 if '$DATA(NURTYPE)
- SET NURTYPE=0
- SET NURSHDR=$SELECT(NURTYPE=0:"AMIS ",1:"Midnight Acuity ")_"Quarterly Report for "_(1700+$EXTRACT(NDATED,1,3))_" Qtr. #"_$EXTRACT(NDATED,7)
- +8 QUIT
- NOVALU(NDA) ;
- +1 ; This function checks inactive units to see if they have acuity
- +2 ; data for the requested reporting period. If a unit has acuity
- +3 ; data a one (1) is returned otherwise a zero (0) is returned,
- +4 NEW NURX
- SET NURX=1
- SET NUNIT=$EXTRACT($PIECE($GET(^NURSA(213.4,NDA,0)),U),9,99)
- +5 IF $GET(^NURSF(211.4,+NUNIT,"I"))="I"
- Begin DoDot:1
- +6 SET D1=0
- FOR
- SET D1=$ORDER(^NURSA(213.4,NDA,1,D1))
- if D1'>0
- QUIT
- if $GET(^NURSA(213.4,NDA,1,D1,0))'=""
- Begin DoDot:2
- +7 IF $PIECE(^NURSA(213.4,NDA,1,D1,0),U,2,6)="0^0^0^0^0"
- SET NURX=0
- +8 QUIT
- End DoDot:2
- +9 QUIT
- End DoDot:1
- +10 KILL NUNIT
- +11 QUIT NURX