source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDAMOS.m@ 636

Last change on this file since 636 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.8 KB
Line 
1SDAMOS ;ALB/CAW - Statistical Report for Appointments;4/15/92
2 ;;5.3;Scheduling;**11,46**;Aug 13, 1993
3 ;SCK - 5/18/93 MODS FOR APP CLININCS AND STOP CODES
4STATS ;
5 N OPT,SDFIN
6 K ^TMP("SDAMS",$J)
7 S SDFIN=0,SDSORT=SDSEL
8 I '$$FORMAT G STATSQ
9 I '$$DIV^SDAMO G STATSQ
10 I SDSEL=6 S VAUTC=1 G STATS1
11 I SDSEL=5 S OPT=$S(FMT=1:"GETCLN",1:"GETSC") D @OPT G:SDFIN STATSQ
12STATS1 ;
13 I '$$COMPL G ^SDAMO
14 W !!,$$LINE^SDAMO("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^SDAMOS
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 Q
25 ;
26START ;
27 U IO
28 K ^TMP("SDAMS",$J)
29 S SDLEN=25,SDPAGE=1,$P(SDASH,"-",IOM+1)="",$P(SDTDASH,"=",IOM+1)="",SDAMDD=$P(^DD(2.98,3,0),U,3)
30 D EN
31 I '$D(^TMP("SDAMS",$J)) D NOREP^SDAMOS1 G STATSQ
32 I FMT=1 D BLD^SDAMOSP
33 I FMT'=1 D BLD^SDAMOS1
34 D STATSQ Q
35 ;
36EN ; build ^TMP global
37 I FMT=1 D BLD1^SDAMOS
38 I FMT'=1 D STOPC^SDAMOS0
39ENQ Q
40 ;
41BLD1 ;
42 I VAUTD=1 S SDDIV=0 D CLINIC
43 S SDDV=0 F S SDDV=$O(VAUTD(SDDV)) Q:'SDDV S SDDIV=SDDV D CLINIC
44 Q
45 ;
46CLINIC ;all clinic or specific clinic
47 ;
48 ;all divisions and all clinics selected
49 I VAUTD=1&(VAUTC=1) D
50 .S SDCLIN=0 F S SDCLIN=$O(^SC(SDCLIN)) Q:'SDCLIN I $$CLINIC^SDAMU(SDCLIN) S SDCLC=$G(^SC(SDCLIN,0)) D PATIENT
51 ;specific division and all clinics selected
52 I SDDIV&(VAUTC=1) D
53 .S SDCLIN=0 F S SDCLIN=$O(^SC(SDCLIN)) Q:'SDCLIN I $$CLINIC^SDAMU(SDCLIN) D
54 ..S SDCLC=$G(^SC(SDCLIN,0)) I SDDIV=$$DIV^SDAMU(.SDCLIN,.VAUTD,.SDNAME,.SDLEN) D PATIENT
55 ;all or specific division(s) and specific clinic(s) selected
56 I VAUTC=0 D
57 .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
58 Q
59 ;
60PATIENT ;loop through appointments - find status of appt.
61 ;
62 S SDDATE=SDBEG-.1
63 F SDDATE=SDDATE:0 S SDDATE=$O(^SC(SDCLIN,"S",SDDATE)) Q:'SDDATE!(SDDATE>(SDEND_".9")) D
64 .S SDAPPT=0 F S SDAPPT=$O(^SC(SDCLIN,"S",SDDATE,1,SDAPPT)) Q:'SDAPPT D SET
65 Q
66 ;
67SET ;Set in ^TMP("SDAMS",$J,Division,Clinic Name,Clinic IFN,Appt Status)
68 ;
69 S SDDV=$$DIV^SDAMU(.SDCLIN,.VAUTD,.SDNAME,.SDLEN),SDPAT=+$G(^SC(SDCLIN,"S",SDDATE,1,SDAPPT,0))
70 S SDATA=$G(^DPT(SDPAT,"S",SDDATE,0)) I 'SDATA G SETQ
71 G:'$$VALID^SDAM2(SDPAT,SDCLIN,SDDATE,SDAPPT) SETQ
72 S SDSTAT=$$STATUS^SDAM1(SDPAT,SDDATE,SDCLIN,SDATA,SDAPPT)
73 S ^(+SDSTAT)=$G(^TMP("SDAMS",$J,SDDV,$P(^SC(SDCLIN,0),U),SDCLIN,+SDSTAT))+1
74 S SDCL("SDAMS",$J,SDDV,+SDSTAT)=$G(SDCL("SDAMS",$J,SDDV,+SDSTAT))+1
75 S SDAT("SDAMS",$J,+SDSTAT)=$G(SDAT("SDAMS",$J,+SDSTAT))+1
76 I +SDSTAT["4^5^6^7",$P(SDSTAT,U,4)'="" S SDCI(SDCLIN,+SDSTAT)=$G(SDCI(SDCLIN,+SDSTAT))+1
77SETQ Q
78 ;
79GETCLN S SDFIN='$$CLINIC^SDAMO Q
80 ;
81GETSC S SDFIN='$$STOP Q
82 ;
83FORMAT() ;
84 N Y S Y=0
85 W !!,$$LINE^SDAMO("Report Format")
86 S FMT=$$OPTION(0)
87 Q (Y)
88 ;
89OPTION(CHECK) ;
90 S X="S^"
91 S X=X_"1:Appointment Clinic;"
92 S X=X_"2:Stop Code"
93 S DIR(0)=X,DIR("A")="Select Report Format",DIR("?")="Select format for printed report",DIR("B")="Appointment Clinic"
94 D ^DIR K DIR
95 Q (+Y)
96QUE ;
97 S ZTRTN="START^SDAMOS",ZTDESC="Appointment Management Report"
98 F X="FMT","VAUTC(","VAUTD(","SDSORT","SDSEL","SDBEG","SDEND","VAUTD","VAUTC" S ZTSAVE(X)=""
99 D ^%ZTLOAD W:$D(ZTSK) !,"Task #",ZTSK," Started."
100 D HOME^%ZIS K IO("Q")
101 Q
102STOP() ;
103 W !!,$$LINE^SDAMO("Stop Code Selection")
104 S DIC="^DIC(40.7,",VAUTSTR="Stop Code",VAUTVB="VAUTC",VAUTNI=2
105 D FIRST^VAUTOMA
106 I Y<0 K VAUTC
107 Q $D(VAUTC)>0
108 ;
109COMPL() ;
110 I '$$DISP^SDAMOS0 S Y=0 G COMPLQ
111 S DIR(0)="Y",DIR("A")="Continue",DIR("?")="Enter 'Y'es or 'N'o.",DIR("B")="YES"
112 D ^DIR K DIR I $D(DTOUT) S Y=0
113COMPLQ Q (Y)
Note: See TracBrowser for help on using the repository browser.