source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGYMBSRX.m@ 1259

Last change on this file since 1259 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.4 KB
Line 
1DGYMBSRX ;ALB/ABR - REPORT OF G&L ORDERS FROM FILE 42
2 ;;5.3;Registration;**59**;Aug 13, 1993
3 ;
4EN ;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
9Q K I,POP,X,ZTDESC,ZTIO,ZTRTN,ZTSK
10 D CLOSE^DGUTQ
11 Q
12 ;
13EN1 ;
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 ;
24KILL K I,J,DGGL,DGGDATE,DGNO,DGLVL,DGOLVL,SAGL,^TMP("DG59",$J)
25 Q
26 ;
27LVL ; 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 ;
33NOGLO ;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 ;
44SAMEGLO ;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 ;
57LEVEL ; 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 ;
65HEADER ; 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
Note: See TracBrowser for help on using the repository browser.