source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDWLAHRE.m@ 1078

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

initial load of WorldVistAEHR

File size: 3.1 KB
RevLine 
[613]1SDWLAHRE ;;IOFO BAY PINES/TEH - EWL REPORT - REPORT EDIT;06/12/2002 ; 20 Aug 2002 2:10 PM
2 ;;5.3;scheduling;**419**;AUG 13 1993;Build 16
3 ;
4 ;
5 ;
6 ;
7 ;
8 ;
9 ;
10EDT ;EDIT TEMPLATE
11 K DIR
12 W ! S DIR(0)="Y",DIR("B")="YES",DIR("A")="Is this SORT template correct" D ^DIR
13 I Y Q
14 I 'Y D
15 .S SDWLSTC=1
16 .K DIR S DIR(0)="Y",DIR("B")="NO",DIR("A")="Delete ALL of the SORT template(s)" D ^DIR
17 .I Y D
18 ..K ^XTMP("SDWLAHR",$J),SDWLSTC W *7," Sort Template deleted." S SDWLC=0 Q
19 G END:'SDWLC
20 I SDWLC=1,'SDWLSTC S SDWLID=SDWLC
21 K DIR I SDWLC>1 S DIR("A")="Delete Which ID: ",DIR(0)="NAO^1:"_SDWLC_":0" D ^DIR D
22 .I Y="",X Q
23 .I Y["^" Q
24 .I Y<1 Q
25 .I Y["^" Q
26 .S SDWLID=Y
27 .S SDWLS0="",SDWLS1=""
28 .S SDWLS0=$O(^XTMP("SDWLAHR",$J,SDWLID,SDWLS0)),SDWLS1=$O(^XTMP("SDWLAHR",$J,SDWLID,SDWLS0,SDWLS1))
29 .S SDWLS3=+$G(^XTMP("SDWLAHR",$J,SDWLID,SDWLS0,SDWLS1))
30 K ^XTMP("SDWLAHR",$J,SDWLID),^XTMP("SDWLAHR",$J,"B"),^XTMP("SDWLAHR",$J,"C")
31SET S SDWLM=0,SDWLS=0
32 F S SDWLM=$O(^XTMP("SDWLAHR",$J,SDWLM)) Q:SDWLM<1 D
33 .S SDWLM0="" F S SDWLM0=$O(^XTMP("SDWLAHR",$J,SDWLM,SDWLM0)) Q:SDWLM0="" D
34 ..S SDWLM1="" F S SDWLM1=$O(^XTMP("SDWLAHR",$J,SDWLM,SDWLM0,SDWLM1)) Q:SDWLM1="" D
35 ...S X=$G(^XTMP("SDWLAHR",$J,SDWLM,SDWLM0,SDWLM1))
36 ...S SDWLM2="" F S SDWLM2=$O(^XTMP("SDWLAHR",$J,SDWLM,SDWLM0,SDWLM1,SDWLM2)) Q:SDWLM2="" D
37 ....S Y=$G(^XTMP("SDWLAHR",$J,SDWLM,SDWLM0,SDWLM1,SDWLM2))
38 ....S SDWLS=SDWLS+1,^XTMP("SDWLAHR",$J,SDWLS,SDWLM0,SDWLM1)=X,^XTMP("SDWLAHR",$J,SDWLS,SDWLM0,SDWLM1,SDWLM2)=Y
39 ....S ^XTMP("SDWLAHR",$J,"B",SDWLM0,SDWLM1,Y,SDWLM2,SDWLS)="",^XTMP("SDWLAHR",$J,"C",+X,SDWLS)=""
40 ....K ^XTMP("SDWLAHR",$J,SDWLM) S SDWLC=SDWLS D DIS
41END K SDWLCC,SDWLF,SDWLID,SDWLM,SDWLMO,SDWLM1,SDWLM2,SDWLMN,SDWLMX,SDWLS,SDWLS0,SDWLS1,SDWLS2,SDWLS3,SDWLX Q
42DIS W:$D(IOF) @IOF W !,?80-$L("EWL AD HOC Report Sort Display")\2,"EWL AD HOC Report Sort Display",!
43 W !,"Sort ID",?9,"Sort Field ID",?30,"Sort Field Name",?50,"Sort Field Condition"
44 W !,"-------",?9,"-------------",?30,"---------------",?50,"-----------------------",!
45 S (SDWLS0,SDWLS1,SDWLS2,SDWLS3,SDWLCC)="" N SDWLIENS
46 F S SDWLCC=$O(^XTMP("SDWLAHR",$J,SDWLCC)) Q:SDWLCC<1 D
47 .F S SDWLS0=$O(^XTMP("SDWLAHR",$J,SDWLCC,SDWLS0)) Q:SDWLS0="" D
48 ..F S SDWLS1=$O(^XTMP("SDWLAHR",$J,SDWLCC,SDWLS0,SDWLS1)) Q:SDWLS1="" D
49 ...S SDWLX=$G(^XTMP("SDWLAHR",$J,SDWLCC,SDWLS0,SDWLS1))
50 ...W !,?3,SDWLCC,?13,$J($P(SDWLX,";"),3),?30,$E(SDWLS1,1,18)
51 ...S SDWLS2="" F S SDWLS2=$O(^XTMP("SDWLAHR",$J,SDWLCC,SDWLS0,SDWLS1,SDWLS2)) Q:SDWLS2="" D
52 ....I SDWLS0["DAT" D Q
53 .....S Y=$P(SDWLS2,U) D DD^%DT W ?50,"Begin Date: ",Y S Y=$P(SDWLS2,U,2) D DD^%DT W !,?50,"End Date: ",Y
54 ....I SDWLS0["NUM" D Q
55 .....S SDWLMN=$P(SDWLS2,U) W ?50,"Minimun: ",SDWLMN S SDWLMX=$P(SDWLS2,U,2) W !,?50,"Maximun: ",SDWLMX
56 ....I SDWLS0["PRT" D Q
57 .....S SDWLF=+$P($P(SDWLX,U,2),"P",2)
58 .....S SDWLIENS=$G(^XTMP("SDWLAHR",$J,SDWLCC,SDWLS0,SDWLS1,SDWLS2)) W ?50,$$GET1^DIQ(SDWLF,SDWLIENS_",",".01"),!
59 ....I SDWLS0["RS" D Q
60 .....W ?50,SDWLS2,!
61 ....I SDWLS0["FT" D Q
62 .....F S SDWLS3=$O(^XTMP("SDWLAHR",$J,SDWLCC,SDWLS0,SDWLS1,SDWLS2,SDWLS3)) Q:SDWLS3="" D
63 ......W:SDWLS2#2>0 ?50,"L-",SDWLS2,?55,SDWLS3
64 ......W:SDWLS2#2=0 !,?50,"L-",SDWLS2,?55,SDWLS3
65 Q
Note: See TracBrowser for help on using the repository browser.