source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDAMOC.m@ 1141

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

initial load of WorldVistAEHR

File size: 4.0 KB
Line 
1SDAMOC ;IOFIO - BAY PINES/TEH - Statistical Report for Cancelled Appointments;4/15/92
2 ;;5.3;Scheduling;**487**;Aug 13, 1993
3 ;SCK - 5/18/93 MODS FOR APP CLININCS AND STOP CODES
4STATS ;
5 K ^TMP("SDAMC"),^TMP("SDAMCD")
6 N POP,%,%ZIS,ZTSAVE
7 S SDFIN=0,SDSORT=SDSEL
8 S FMT=$$OPTION()
9 I '$$DIV^SDAMO G STATSQ
10 I SDSEL=6 S VAUTC=1 G STATS1
11 I SDSEL=5 S OPT="GETCLN" D @OPT G:SDFIN STATSQ
12STATS1 ;
13 I '$$COMPL G ^SDAMOCC
14 W !!,$$LINE^SDAMOCC("Device Selection")
15 W !!,"This output requires 132 columns.",!!
16 S %ZIS="PQM" D ^%ZIS G STATSQ:POP
17 I $D(IO("Q")) D QUE G STATSQ
18 W ! D WAIT^DICD
19 D START^SDAMOC
20STATSQ ;
21 D:'$D(ZTQUEUED) ^%ZISC
22 K SDAMDD,SDAPPT,SDASH,SDAT,SDATA,SDAT,SDCL,SDCLC,SDCLI,SDCLIN,SDCOL,SDDATE,SDDIV,SDDV,SDFLG,SDI,SDLEN,SDNXT,SDPAGE,SDPAT,SDSTAT,SDSTOP,SDTDASH
23 K ^TMP("SDAMS",$J),SDSEL,FMT,SDFIN,SDRUN,SCTOT,BLD,VAUTC,VAUTD,SDBEG,SDEND,VAUTNI,VAUTSTR,VAUTVB,SDSORT,DIC,DTOUT,DUOUT,DIROUT
24 K SDCI,SDDFN,SDASH,SDAT,SDBEG,SDCL,SDDV,SDDVNM,SDDVNM,SDEND,SDFLG,SDNXT
25 K SDPAGE,SDSTOP,SDTAB,SDTDASH,SDTOTT,SDY,Y
26 K OPT,SDFIN,SDDFN,SDNAME,X,Y
27 Q
28 ;
29START ;
30 U IO
31 K ^TMP("SDAMC",$J)
32 S SDLEN=25,SDPAGE=1,$P(SDASH,"-",IOM+1)="",$P(SDTDASH,"=",IOM+1)="",SDAMDD=$P(^DD(2.98,3,0),U,3)
33 D EN
34 I '$D(^TMP("SDAMC",$J)) D NOREP G STATSQ
35 I FMT=1 D BLD^SDAMOCP
36 I FMT'=1 D BLD^SDAMOCP1
37 D STATSQ Q
38 ;
39EN ; build ^TMP global
40 I FMT=1 D BLD1^SDAMOC
41 I FMT'=1 D BLD1^SDAMOC
42ENQ Q
43 ;
44BLD1 ;
45 I VAUTD=1 S SDDIV=0 D CLINIC
46 S SDDV=0 F S SDDV=$O(VAUTD(SDDV)) Q:'SDDV S SDDIV=SDDV D CLINIC
47 Q
48 ;
49CLINIC ;all clinic or specific clinic
50 ;
51 ;all divisions and all clinics selected
52 I VAUTD=1&(VAUTC=1) D
53 .S SDCLIN=0 F S SDCLIN=$O(^SC(SDCLIN)) Q:'SDCLIN I $$CLINIC^SDAMU(SDCLIN) S SDCLC=$G(^SC(SDCLIN,0)) D PATIENT
54 ;specific division and all clinics selected
55 I SDDIV&(VAUTC=1) D
56 .S SDCLIN=0 F S SDCLIN=$O(^SC(SDCLIN)) Q:'SDCLIN I $$CLINIC^SDAMU(SDCLIN) D
57 ..S SDCLC=$G(^SC(SDCLIN,0)) I SDDIV=$$DIV^SDAMU(.SDCLIN,.VAUTD,.SDNAME,.SDLEN) D PATIENT
58 ;all or specific division(s) and specific clinic(s) selected
59 I VAUTC=0 D
60 .S SDCLIN=0 F S SDCLIN=$O(VAUTC(SDCLIN)) Q:'SDCLIN S SDCLC=$G(^SC(+SDCLIN,0)) D:VAUTD!(SDDIV=$$DIV^SDAMU(.SDCLIN,.VAUTD,.SDNAME,.SDLEN)) PATIENT
61 Q
62 ;
63PATIENT ;loop through appointments - find status of appt.
64 ;
65 S SDDATE=SDBEG-.1 N SDCTYP
66 F SDDATE=SDDATE:0 S SDDATE=$O(^DPT("ASDCN",SDCLIN,SDDATE)) Q:'SDDATE!(SDDATE>(SDEND_".9")) D
67 .S SDDFN=0 F S SDDFN=$O(^DPT("ASDCN",SDCLIN,SDDATE,SDDFN)) Q:SDDFN="" D SET
68 Q
69 ;
70SET ;Set in ^TMP("SDAMC",$J,Division,Clinic Name,Clinic)
71 ;
72 S SDDV=$$DIV^SDAMU(.SDCLIN,.VAUTD,.SDNAME,.SDLEN)
73 S SDATA=$G(^DPT(SDDFN,"S",SDDATE,0)) I 'SDATA G SETQ
74 S SDCTYP=$P(SDATA,U,2) I SDCTYP="" G SETQ
75 I SDCTYP="N"!(SDCTYP="NT")!(SDCTYP="NA")!(SDCTYP="I") G SETQ
76 S SDCTYP=$S(SDCTYP="C":1,SDCTYP="CA":2,SDCTYP="PC":3,SDCTYP="PCA":4,1:1)
77 S ^TMP("SDAMC",$J,SDDV,SDCLIN,SDCTYP)=$G(^TMP("SDAMC",$J,SDDV,SDCLIN,SDCTYP))+1
78 S ^TMP("SDAMCD",$J,SDDV,$P(SDATA,"^",2),SDCLIN,SDDATE,SDDFN)=SDATA_";"_SDDATE
79SETQ Q
80 ;
81GETCLN S SDFIN='$$CLINIC^SDAMO Q
82 ;
83GETSC S SDFIN='$$STOP Q
84 ;
85NOREP ;report if no data in TMP global
86 W !!,?29,"Cancelled Clinic Report"
87 W !,?20,"Date Range ",$$FDATE^VALM1(SDBEG)_" to "_$$FDATE^VALM1(SDEND)
88 D NOW^%DTC W !,?20,"Run Date: ",$E($$FDTTM^VALM1(%),1,14),?50,"Page: 1"
89 W !,SDASH
90 W !!?20,"No data found matching sort parameters"
91 Q
92 ;
93OPTION(CHECK) ;
94 S X="S^"
95 S X=X_"1:Summary;"
96 S X=X_"2:Detail"
97 S DIR(0)=X,DIR("A")="Select Report Format",DIR("?")="Select format for printed report",DIR("B")="Summary"
98 D ^DIR K DIR
99 Q (+Y)
100QUE ;
101 S ZTRTN="START^SDAMOC",ZTDESC="Cancelled Clinic Report"
102 F X="FMT","VAUTC(","VAUTD(","SDSORT","SDSEL","SDBEG","SDEND","VAUTD","VAUTC" S ZTSAVE(X)=""
103 D ^%ZTLOAD W:$D(ZTSK) !,"Task #",ZTSK," Started."
104 D HOME^%ZIS K IO("Q"),ZTSK,ZTDESC,ZTQUEUED,ZTRTN
105 Q
106STOP() ;
107 W !!,$$LINE^SDAMO("Stop Code Selection")
108 S DIC="^DIC(40.7,",VAUTSTR="Stop Code",VAUTVB="VAUTC",VAUTNI=2
109 D FIRST^VAUTOMA
110 I Y<0 K VAUTC
111 Q $D(VAUTC)>0
112 ;
113COMPL() ;
114 I '$$DISP^SDAMOC0 S Y=0 G COMPLQ
115 S DIR(0)="Y",DIR("A")="Continue",DIR("?")="Enter 'Y'es or 'N'o.",DIR("B")="YES"
116 D ^DIR K DIR I $D(DTOUT) S Y=0
117COMPLQ Q (Y)
Note: See TracBrowser for help on using the repository browser.