| 1 | DGYMBSRX ;ALB/ABR - REPORT OF G&L ORDERS FROM FILE 42
|
|---|
| 2 | ;;5.3;Registration;**59**;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | EN ;set up temp global based on G&L ORDER
|
|---|
| 5 | W !!,"WARD LOCATION FILE DIAGNOSTIC ROUTINE",!!
|
|---|
| 6 | S ZTDESC="Diagnostic List for WARD LOCATION file",ZTRTN="EN1^DGYMBSRX"
|
|---|
| 7 | D ZIS^DGUTQ
|
|---|
| 8 | I 'POP D EN1^DGYMBSRX
|
|---|
| 9 | Q K I,POP,X,ZTDESC,ZTIO,ZTRTN,ZTSK
|
|---|
| 10 | D CLOSE^DGUTQ
|
|---|
| 11 | Q
|
|---|
| 12 | ;
|
|---|
| 13 | EN1 ;
|
|---|
| 14 | D KILL
|
|---|
| 15 | S DGGDATE=$$HTE^XLFDT($H)
|
|---|
| 16 | N PAGE,FLAG,LINE S (PAGE,FLAG)=0
|
|---|
| 17 | D HEADER I FLAG Q
|
|---|
| 18 | F I=0:0 S I=$O(^DIC(42,I)) Q:'I S DGGL=+$G(^DIC(42,I,"ORDER")) S ^TMP("DG59",$J,DGGL)=$G(^TMP("DG59",$J,DGGL))+1,^(DGGL,I)="" D LVL
|
|---|
| 19 | D NOGLO I FLAG G KILL
|
|---|
| 20 | D SAMEGLO I FLAG G KILL
|
|---|
| 21 | D LEVEL I FLAG G KILL
|
|---|
| 22 | W:$E(IOST,1,2)="C-" !!,">> DONE!"
|
|---|
| 23 | ;
|
|---|
| 24 | KILL K I,J,DGGL,DGGDATE,DGNO,DGLVL,DGOLVL,SAGL,^TMP("DG59",$J)
|
|---|
| 25 | Q
|
|---|
| 26 | ;
|
|---|
| 27 | LVL ; check for sequential TOTALS
|
|---|
| 28 | N DGLVL,DGOLVL
|
|---|
| 29 | F DGLVL=0:0 S DGOLVL=DGLVL,DGLVL=$O(^DIC(42,I,1,DGLVL)) Q:'DGLVL I DGLVL-DGOLVL'=1 S ^TMP("DG59",$J,"DGLVL",I)=$P(^DIC(42,I,0),"^")
|
|---|
| 30 | K DGLVL,DGOLVL
|
|---|
| 31 | Q
|
|---|
| 32 | ;
|
|---|
| 33 | NOGLO ;LOCATIONS W/ NO G&L ORDER
|
|---|
| 34 | I '$G(^TMP("DG59",$J,0)) Q
|
|---|
| 35 | S $P(LINE,"=",31)=""
|
|---|
| 36 | W !!,"**The following ward locations have no G&L order, ",!,"and do not appear on the G&L Sheet or Bed Status Report."
|
|---|
| 37 | W !!,"IEN",?10,"Ward Location",!,LINE
|
|---|
| 38 | F DGNO=0:0 S DGNO=$O(^TMP("DG59",$J,0,DGNO)) Q:'DGNO D Q:FLAG
|
|---|
| 39 | .I $Y>(IOSL-4) D HEADER I FLAG Q
|
|---|
| 40 | .W !,DGNO,?10,$P(^DIC(42,DGNO,0),"^")
|
|---|
| 41 | W !
|
|---|
| 42 | Q
|
|---|
| 43 | ;
|
|---|
| 44 | SAMEGLO ;shared g&l orders
|
|---|
| 45 | N DGCHK S DGCHK=1
|
|---|
| 46 | F I=0:0 S I=$O(^TMP("DG59",$J,I)) Q:'I I ^(I)>1 D
|
|---|
| 47 | .I DGCHK,$Y>(IOSL-8) D HEADER I FLAG Q
|
|---|
| 48 | .I DGCHK W !!,"*SHARED G&L ORDERS*",!,"===================" S DGCHK=0
|
|---|
| 49 | . W !!,"The following locations all have the G&L ORDER = ",I
|
|---|
| 50 | . F SAGL=0:0 S SAGL=$O(^TMP("DG59",$J,I,SAGL)) Q:'SAGL D Q:FLAG
|
|---|
| 51 | ..I $Y>(IOSL-4) D HEADER I FLAG Q
|
|---|
| 52 | ..W !,"IEN = ",SAGL,?12,"WARD LOCATION = ",$P(^DIC(42,SAGL,0),"^")
|
|---|
| 53 | . W !?15,"*** ONLY THE LAST OF THIS GROUP WILL APPEAR ON THE BSR ***"
|
|---|
| 54 | W !
|
|---|
| 55 | Q
|
|---|
| 56 | ;
|
|---|
| 57 | LEVEL ; list wards with problem TOTALS
|
|---|
| 58 | S $P(LINE,"=",31)=""
|
|---|
| 59 | I '$O(^TMP("DG59",$J,"DGLVL",0)) Q
|
|---|
| 60 | W !!,"**The following locations are missing lower level TOTALS:",!
|
|---|
| 61 | W !,"IEN",?10,"Ward Location",!,LINE
|
|---|
| 62 | F DGLVL=0:0 S DGLVL=$O(^TMP("DG59",$J,"DGLVL",DGLVL)) Q:'DGLVL W !,DGLVL,?10,^(DGLVL)
|
|---|
| 63 | Q
|
|---|
| 64 | ;
|
|---|
| 65 | HEADER ; print header for diagnostics report
|
|---|
| 66 | N DIR,DIRUT,DTOUT,DUOUT,LINE2,X,Y,I
|
|---|
| 67 | S PAGE=PAGE+1,$P(LINE2,"=",80)=""
|
|---|
| 68 | I $E(IOST,1,2)="C-",(PAGE>1) S DIR(0)="E" D ^DIR S FLAG='Y I FLAG Q
|
|---|
| 69 | W @IOF,!,"WARD LOCATION FILE Diagnostics Report",?70,"PAGE: ",$J(PAGE,2)
|
|---|
| 70 | W !,DGGDATE
|
|---|
| 71 | W !,LINE2
|
|---|
| 72 | Q
|
|---|
