- NURAMH9 ;HIRMFO/JH,FT,MD-MANHOURS EXCEPTION REPORT ;4/28/97
- ;;4.0;NURSING SERVICE;**1,2**;Apr 25, 1997
- EN1 ;
- Q:'$D(^DIC(213.9,1,"OFF")) Q:$P(^DIC(213.9,1,"OFF"),"^",1)=1
- S (NUROUT,NUROUTSW)=0
- S NHOSPSW=0 D WARDSEL^NURARMH0 I NUROUT G QT
- G ASKDAT
- EN2 ;
- Q:'$D(^DIC(213.9,1,"OFF")) Q:$P(^DIC(213.9,1,"OFF"),"^")=1
- S NHOSPSW=1,(NUROUT,NUROUTSW,NURMDSW)=0
- D EN9^NURSAGSP I NURMDSW W ! S DIC(0)="AEQMZ" D EN8^NURSAGSP G QT:$G(NUROUT)
- ASKDAT D EN7^NURSAGP1 S NUROUTSW=$G(NUROUT) G:NUROUTSW QT
- S NSP(1)=$P(NDATED,"^"),NSP(2)=$P(NDATED,"^",2)
- W ! S ZTRTN="START^NURAMH9",ZTDESC="MANHOUR EXCEPTION REPORT" D EN7^NURSUT0 G:POP!($D(ZTSK)) QT
- START ;
- U IO K ^TMP($J) S (NURSW1,NURPAGE,NBK)=0
- S NURX=+NDATED_" 0" F S NURX=$O(^NURSA(213.4,"B",NURX)) Q:$E(NURX,1,7)>$P(NDATED,U,2)!(NURX="") S DA=$O(^NURSA(213.4,"B",NURX,0)) I $G(^NURSA(213.4,DA,0))'="",$P(^(0),U,2)="",$P(^(0),U,3)="",$P(^(0),U,4)="" D Q:NUROUT
- . S NURDATA=$G(^NURSA(213.4,DA,0)) Q:NURDATA="" S (YY(0),NPWARD)=+$E(NURDATA,9,99) S:NHOSPSW NURSWARD=+$E(NURDATA,9,99) I 'NHOSPSW,YY(0)'=NURSWARD Q
- . Q:+NPWARD'>0!($P($G(^NURSF(211.4,+NPWARD,0)),U)="")!($P($G(^NURSF(211.4,+NPWARD,1)),U)="I")!($P($G(^NURSF(211.4,+NPWARD,"I")),U)="I")
- . S NURFAC(2)=$S($$EN12^NURSUT3(NPWARD)'="":$$EN12^NURSUT3(NPWARD),1:" BLANK") I $G(NURFAC)=0,NURFAC(2)'=" BLANK",NURFAC(2)'=NURFAC(1) Q
- . S NDATE=$E(NURDATA,1,7),NURSHFT=$E(NURDATA,8) S NPWARD=NURSWARD D EN6^NURSAUTL S ^TMP($J,NURFAC(2),NDATE,NPWARD,NURSHFT)=""
- . Q
- I '$D(^TMP($J)) S NURFAC(2)=$S($G(NURFAC)=0:NURFAC(1),1:"") D HEADER S Y=NSP(1) D:+Y D^DIQ S Y(1)=Y,Y=NSP(2) D:+Y D^DIQ S Y(2)=Y W !!,$C(7),"No exception records for "_Y(1)_" - "_Y(2) S NUROUT=1 G QT
- S NURFAC(2)="" F S NURFAC(2)=$O(^TMP($J,NURFAC(2))) Q:NURFAC(2)="" D:NHOSPSW HEADER D Q:NUROUT
- . S NDATE=0 F S NDATE=$O(^TMP($J,NURFAC(2),NDATE)) Q:NDATE'>0!(NUROUT) D Q:NUROUT S NBK=0
- . . S NWRD="" F S NWRD=$O(^TMP($J,NURFAC(2),NDATE,NWRD)) Q:NWRD=""!(NUROUT) W ! S NURSHFT="" F S NURSHFT=$O(^TMP($J,NURFAC(2),NDATE,NWRD,NURSHFT)) Q:NURSHFT="" D Q:NUROUT
- . . . I ($Y>(IOSL-6))!'(NURSW1) D HEADER Q:NUROUT
- . . . D:'NBK HEADER1 S NBK=1 W !,?28,$E(NWRD,1,10),?48,$S(NURSHFT="D":"DAY",NURSHFT="E":"EVENING",NURSHFT="N":"NIGHT",1:"")
- . . . Q
- . . Q
- . Q
- QT K ^TMP($J) D CLOSE^NURSUT1,^NURAKILL
- Q
- I '$D(ZTSK),$E(IOST)="C",NURSW1 D ENDPG^NURSUT1 Q:NUROUT
- S NURSX="",$P(NURSX,"-",80)="",NURPAGE=NURPAGE+1,Y=DT D:+Y D^DIQ
- W:$E(IOST)="C"!(NURPAGE>1) @IOF
- I NHOSPSW,NURMDSW W !,?$$CNTR^NURSUT2(NURFAC(2)),$$FACL^NURSUT2(NURFAC(2))
- W !,Y,?28,"MANHOURS EXCEPTION REPORT",?66,"PAGE: ",NURPAGE,!!,?28,"LOCATION",?47,"SHIFT",!,NURSX
- S NURSW1=1
- Q
- S Y=NDATE D:+Y D^DIQ W !,?32,Y,!,?32,$$REPEAT^XLFSTR("-",12),!
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURAMH9 2782 printed Mar 13, 2025@21:24:32 Page 2
- NURAMH9 ;HIRMFO/JH,FT,MD-MANHOURS EXCEPTION REPORT ;4/28/97
- +1 ;;4.0;NURSING SERVICE;**1,2**;Apr 25, 1997
- EN1 ;
- +1 if '$DATA(^DIC(213.9,1,"OFF"))
- QUIT
- if $PIECE(^DIC(213.9,1,"OFF"),"^",1)=1
- QUIT
- +2 SET (NUROUT,NUROUTSW)=0
- +3 SET NHOSPSW=0
- DO WARDSEL^NURARMH0
- IF NUROUT
- GOTO QT
- +4 GOTO ASKDAT
- EN2 ;
- +1 if '$DATA(^DIC(213.9,1,"OFF"))
- QUIT
- if $PIECE(^DIC(213.9,1,"OFF"),"^")=1
- QUIT
- +2 SET NHOSPSW=1
- SET (NUROUT,NUROUTSW,NURMDSW)=0
- +3 DO EN9^NURSAGSP
- IF NURMDSW
- WRITE !
- SET DIC(0)="AEQMZ"
- DO EN8^NURSAGSP
- if $GET(NUROUT)
- GOTO QT
- ASKDAT DO EN7^NURSAGP1
- SET NUROUTSW=$GET(NUROUT)
- if NUROUTSW
- GOTO QT
- +1 SET NSP(1)=$PIECE(NDATED,"^")
- SET NSP(2)=$PIECE(NDATED,"^",2)
- +2 WRITE !
- SET ZTRTN="START^NURAMH9"
- SET ZTDESC="MANHOUR EXCEPTION REPORT"
- DO EN7^NURSUT0
- if POP!($DATA(ZTSK))
- GOTO QT
- START ;
- +1 USE IO
- KILL ^TMP($JOB)
- SET (NURSW1,NURPAGE,NBK)=0
- +2 SET NURX=+NDATED_" 0"
- FOR
- SET NURX=$ORDER(^NURSA(213.4,"B",NURX))
- if $EXTRACT(NURX,1,7)>$PIECE(NDATED,U,2)!(NURX="")
- QUIT
- SET DA=$ORDER(^NURSA(213.4,"B",NURX,0))
- IF $GET(^NURSA(213.4,DA,0))'=""
- IF $PIECE(^(0),U,2)=""
- IF $PIECE(^(0),U,3)=""
- IF $PIECE(^(0),U,4)=""
- Begin DoDot:1
- +3 SET NURDATA=$GET(^NURSA(213.4,DA,0))
- if NURDATA=""
- QUIT
- SET (YY(0),NPWARD)=+$EXTRACT(NURDATA,9,99)
- if NHOSPSW
- SET NURSWARD=+$EXTRACT(NURDATA,9,99)
- IF 'NHOSPSW
- IF YY(0)'=NURSWARD
- QUIT
- +4 if +NPWARD'>0!($PIECE($GET(^NURSF(211.4,+NPWARD,0)),U)="")!($PIECE($GET(^NURSF(211.4,+NPWARD,1)),U)="I")!($PIECE($GET(^NURSF(211.4,+NPWARD,"I")),U)="I")
- QUIT
- +5 SET NURFAC(2)=$SELECT($$EN12^NURSUT3(NPWARD)'="":$$EN12^NURSUT3(NPWARD),1:" BLANK")
- IF $GET(NURFAC)=0
- IF NURFAC(2)'=" BLANK"
- IF NURFAC(2)'=NURFAC(1)
- QUIT
- +6 SET NDATE=$EXTRACT(NURDATA,1,7)
- SET NURSHFT=$EXTRACT(NURDATA,8)
- SET NPWARD=NURSWARD
- DO EN6^NURSAUTL
- SET ^TMP($JOB,NURFAC(2),NDATE,NPWARD,NURSHFT)=""
- +7 QUIT
- End DoDot:1
- if NUROUT
- QUIT
- +8 IF '$DATA(^TMP($JOB))
- SET NURFAC(2)=$SELECT($GET(NURFAC)=0:NURFAC(1),1:"")
- DO HEADER
- SET Y=NSP(1)
- if +Y
- DO D^DIQ
- SET Y(1)=Y
- SET Y=NSP(2)
- if +Y
- DO D^DIQ
- SET Y(2)=Y
- WRITE !!,$CHAR(7),"No exception records for "_Y(1)_" - "_Y(2)
- SET NUROUT=1
- GOTO QT
- +9 SET NURFAC(2)=""
- FOR
- SET NURFAC(2)=$ORDER(^TMP($JOB,NURFAC(2)))
- if NURFAC(2)=""
- QUIT
- if NHOSPSW
- DO HEADER
- Begin DoDot:1
- +10 SET NDATE=0
- FOR
- SET NDATE=$ORDER(^TMP($JOB,NURFAC(2),NDATE))
- if NDATE'>0!(NUROUT)
- QUIT
- Begin DoDot:2
- +11 SET NWRD=""
- FOR
- SET NWRD=$ORDER(^TMP($JOB,NURFAC(2),NDATE,NWRD))
- if NWRD=""!(NUROUT)
- QUIT
- WRITE !
- SET NURSHFT=""
- FOR
- SET NURSHFT=$ORDER(^TMP($JOB,NURFAC(2),NDATE,NWRD,NURSHFT))
- if NURSHFT=""
- QUIT
- Begin DoDot:3
- +12 IF ($Y>(IOSL-6))!'(NURSW1)
- DO HEADER
- if NUROUT
- QUIT
- +13 if 'NBK
- DO HEADER1
- SET NBK=1
- WRITE !,?28,$EXTRACT(NWRD,1,10),?48,$SELECT(NURSHFT="D":"DAY",NURSHFT="E":"EVENING",NURSHFT="N":"NIGHT",1:"")
- +14 QUIT
- End DoDot:3
- if NUROUT
- QUIT
- +15 QUIT
- End DoDot:2
- if NUROUT
- QUIT
- SET NBK=0
- +16 QUIT
- End DoDot:1
- if NUROUT
- QUIT
- QT KILL ^TMP($JOB)
- DO CLOSE^NURSUT1
- DO ^NURAKILL
- +1 QUIT
- +1 IF '$DATA(ZTSK)
- IF $EXTRACT(IOST)="C"
- IF NURSW1
- DO ENDPG^NURSUT1
- if NUROUT
- QUIT
- +2 SET NURSX=""
- SET $PIECE(NURSX,"-",80)=""
- SET NURPAGE=NURPAGE+1
- SET Y=DT
- if +Y
- DO D^DIQ
- +3 if $EXTRACT(IOST)="C"!(NURPAGE>1)
- WRITE @IOF
- +4 IF NHOSPSW
- IF NURMDSW
- WRITE !,?$$CNTR^NURSUT2(NURFAC(2)),$$FACL^NURSUT2(NURFAC(2))
- +5 WRITE !,Y,?28,"MANHOURS EXCEPTION REPORT",?66,"PAGE: ",NURPAGE,!!,?28,"LOCATION",?47,"SHIFT",!,NURSX
- +6 SET NURSW1=1
- +7 QUIT
- +1 SET Y=NDATE
- if +Y
- DO D^DIQ
- WRITE !,?32,Y,!,?32,$$REPEAT^XLFSTR("-",12),!
- +2 QUIT
