source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDAMODO.m@ 1361

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

initial load of WorldVistAEHR

File size: 3.1 KB
Line 
1SDAMODO ;ALB/SCK - PROVIDER DIAGNOSTICS REPORT; 4/21/93 ; 05 Oct 98 8:39 PM
2 ;;5.3;Scheduling;**25,132,159**;Aug 13, 1993
3START ;
4 N SORT1,SORT2,SDBEG,SDEND,VAUTD,CLINIC,PATN,PROVDR,STOPC,PDIAG
5 D HOME^%ZIS
6SORTS ;
7 I '$$RANGE G EXIT
8 I '$$DIV G EXIT
9 I '$$SORT1 G EXIT
10 I '$$SORT2 G EXIT
11PICKS ;
12 I SORT1=1!(SORT2=1) G EXIT:'$$PROV
13 I SORT1=2!(SORT2=2) G EXIT:'$$DIAG
14 I SORT1=3!(SORT2=3) G EXIT:'$$PAT
15 I SORT1=4!(SORT2=4) G EXIT:'$$CLINIC
16 I SORT1=5!(SORT2=5) G EXIT:'$$STOP
17FIN ;
18 I '$$COMPL G SORTS
19PRINT ;
20 W !,"This report requires 132 columns for printout"
21 S %ZIS="PMQ" D ^%ZIS G EXIT:POP
22 I $D(IO("Q")) D QUE G EXIT
23 W ! D WAIT^DICD
24 D ^SDAMODO2
25EXIT ;
26 D:'$D(ZTQUEUED) ^%ZISC
27 K VAUTC,VAUTD,VAUTS,DIC,STR,CHECK,VAUTSTR,VAUTVB,X,Y,VAUTNI,SORT1,SORT2,SDEND,SDBEG
28 Q
29 ;
30CLINIC() ;
31 W !!,$$LINE("Clinic Selection")
32 S DIC="^SC(",VAUTSTR="Clinic",VAUTVB="CLINIC",VAUTNI=2,DIC("S")="I $P(^(0),U,3)[""C"""
33 D FIRST^VAUTOMA
34 I Y<0 K CLINIC
35 Q $D(CLINIC)>0
36 ;
37STOP() ;
38 W !!,$$LINE("Stop Codes Selection")
39 S DIC="^DIC(40.7,",VAUTSTR="Stop Code",VAUTVB="STOPC",VAUTNI=2
40 D FIRST^VAUTOMA
41 I Y<0 K STOPC
42 Q $D(STOPC)>0
43 ;
44PAT() ;
45 W !!,$$LINE("Select Patients")
46 S DIC="^DPT(",VAUTSTR="Patient",VAUTVB="PATN",VAUTNI=2
47 D FIRST^VAUTOMA
48 I Y<0 K PATN
49 Q $D(PATN)>0
50 ;
51PROV() ; select provider
52 W !!,$$LINE("Select Providers")
53 S DIC="^VA(200,",VAUTSTR="Provider",VAUTVB="PROVDR",VAUTNI=2
54 D FIRST^VAUTOMA
55 I Y<0 K PROVDR
56 Q $D(PROVDR)>0
57 ;
58DIAG() ;
59 W !!,$$LINE("Select Diagnosis Code")
60 S DIC="^ICD9(",VAUTSTR="Diagnosis",VAUTVB="PDIAG",VAUTNI=2
61 D FIRST^VAUTOMA
62 I Y<0 K PDIAG
63 Q $D(PDIAG)>0
64 ;
65RANGE() ; select date range for report
66 W !!,$$LINE("Date Range Selection")
67 Q $$RANGE^SDAMQ(.SDBEG,.SDEND)
68 ;
69SORT1() ; first level sort
70 W !!,$$LINE("First level sort will be by Division")
71 W !,$$LINE("Select Second Sort Level")
72 S SORT1=$$OPTIONS(0)
73 Q (Y)
74 ;
75SORT2() ; second level sort
76 W !!,$$LINE("Sorting by Division and "_$P($T(SORT+SORT1^SDAMODO1),";;",2))
77 W !,$$LINE("Select Third Sort Level")
78 S SORT2=$$OPTIONS(SORT1)
79 Q (Y)
80 ;
81DIV() ;
82 W:$P($G(^DG(43,1,"GL")),U,2) !!,$$LINE("Division Selection")
83 D ASK2^SDDIV I Y<0 K VAUTD
84 Q $D(VAUTD)>0
85 ;
86COMPL() ;
87 I '$$SHOW^SDAMODO1 S Y=0 G COMPLQ
88 S DIR(0)="Y",DIR("A")="Continue",DIR("?")="Enter 'Y'es or 'N'o.",DIR("B")="YES" D ^DIR
89COMPLQ Q (Y)
90 ;
91LINE(STR) ; print display line
92 N X
93 S:STR]"" STR=" "_STR_" "
94 S $P(X,"_",(IOM/2)-($L(STR)/2))=""
95 Q X_STR_X
96 ;
97OPTIONS(CHECK) ; display options for sorting reports
98 S X="S^"
99 S X=X_$S(CHECK=1:":[Selected];",1:"1:Provider;")
100 S X=X_$S(CHECK=2:":[Selected];",1:"2:Diagnosis [DX];")
101 S X=X_$S(CHECK=3:":[Selected];",1:"3:Patient;")
102 S X=X_$S(CHECK=4:":[Selected];",1:"4:Clinic;")
103 S X=X_$S(CHECK=5:":[Selected]",1:"5:Primary Stop Code")
104 S DIR(0)=X,DIR("A")="Select Sort Option"
105 D ^DIR K DIR
106 Q (+Y)
107 ;
108QUE ;
109 S ZTRTN="^SDAMODO2",ZTDESC="PROVIDER DX REPORT"
110 F X="SORT1","SORT2","SDBEG","SDEND","VAUTD(","CLINIC(","PATN(","PROVDR(","STOPC(","PDIAG(","VAUTD","CLINIC","PATN","PROVDR","STOPC","PDIAG" S ZTSAVE(X)=""
111 D ^%ZTLOAD W:$D(ZTSK) !,"TASK #: ",ZTSK
112 D HOME^%ZIS K IO("Q")
113 Q
114 ;
115ERR ;
116 W !!,"NOT AVAILABLE"
117 Q
Note: See TracBrowser for help on using the repository browser.