source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDAMLD.m@ 623

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

initial load of WorldVistAEHR

File size: 3.0 KB
Line 
1SDAMLD ;ALB/CAW - Ambulartory Status Update Log Utilities ; 3/6/92
2 ;;5.3;Scheduling;;Aug 13, 1993
3 ;
4EN D DT^DICRW S X=$T(+1),DIK="^DOPT("""_$P(X," ;",1)_""","
5 G:$D(^DOPT($P(X," ;"),4)) A S ^DOPT($P(X," ;"),0)=$P(X,";",3)_"^1N^" F I=1:1 S Y=$T(@I) Q:Y="" S ^DOPT($P(X," ;"),I,0)=$P(Y,";",3,99)
6 D IXALL^DIK
7A ;
8 W !! S DIC="^DOPT("""_$P($T(+1)," ;")_""",",DIC(0)="IQEAM" D ^DIC Q:Y<0 D @+Y G A
9 ;
101 ;;Update Appointment Status
11 ;
12 G EN^SDAMQ
13 ;
142 ;;View Log Date (single entry)
15 ;
16 S SDEF="LAST"
17SELECT W !!,"Select APPOINTMENT DATE: "_$S(SDEF]"":SDEF_"// ",1:"") R SDWHEN:DTIME
18 I '$T!(SDWHEN["^") G Q2
19 I SDEF="",SDWHEN="" G Q2
20 I SDEF]"",SDWHEN="" S SDWHEN=SDEF
21 I $$UPPER^VALM1(SDWHEN)=$E("LAST",1,$L(SDWHEN)) W $E("LAST",$L(SDWHEN)+1,4) S D0=$$LAST() G SHOW:D0 W !,*7,"o update has not completed in the last 100 days" G SELECT
22 ;
23 S X=SDWHEN,DIC="^SDD(409.65,",DIC(0)="EMQ" D ^DIC K DIC G SELECT:Y<0 S D0=+Y
24 ;
25SHOW S SDEF="",X="SDAMXLD" X ^%ZOSF("TEST") I $T W:$D(IOF) @IOF W "Appointment Status Log" K DXS D HEAD^SDAMXLD,^SDAMXLD K DXS G SELECT
26 S D0=DA,DIC="^SDD(409.65," D EN^DIQ G SELECT
27Q2 K SDWHEN,SDEF,D0,Y,X,DA,DIC Q
28 ;
293 ;;View Log Date (date range)
30 ;
31 N SDT00,SDBD,SDED,BEGDATE,ENDDATE,X
32 S SDT00="AEX" D DATE^SDUTL G:'$D(SDED) Q3
33 S L=0,FLDS="[SDAMVLD]",BY="@.01",FR=SDBD,TO=SDED
34 S DHD="Appointment Status Update Log from "_$$FTIME^VALM1(BEGDATE)_" to "_$$FTIME^VALM1(ENDDATE)
35 S DIC="^SDD(409.65," D EN1^DIP
36Q3 Q
37 ;
384 ;;Purge log entries (data will be kept for current+1 FYs)
39 ;
40 N SDLFY,SDMAX,SDBD,SDED,BEGDATE,ENDDATE,SDLIM,SDT00,X,Y
41 S SDLIM=($E(DT,1,3)-$S($E(DT,4,5)>9:1,1:2))_"1001"
42 W !,"This option will not purge dates beyond " S X1=SDLIM,X2=-1 D C^%DTC S (Y,SDLFY,SDMAX)=X D DT^DIQ W "."
43 S %DT(0)=-X,SDT00="AEX" D DATE^SDUTL G:'$D(SDED) Q4 S SDCNT=0
44 I SDED<SDMAX S SDMAX=SDED
45 S Y=$$QUE
46 Q
47 ;
48EN4 ;
49 N DIK,SDI,DA,SDCNT
50 S DIK="^SDD(409.65,",SDCNT=0
51 F SDI=SDBD:0 S SDI=$O(^SDD(409.65,"B",SDI)) Q:'SDI!(SDI>SDMAX) S DA=$O(^(SDI,0)) D ^DIK S SDCNT=SDCNT+1
52 D BULL
53Q4 Q
54 ;
55LAST() ;
56 ; input - no input (user selection of last)
57 ; output - the latest date, beginning day or -100 days
58 ;
59 N SDI,LAST
60 F SDI=0:1:100 S X1=DT,X2=-SDI D C^%DTC S LAST=$O(^SDD(409.65,"B",X,0)) S LAST1=$P($G(^SDD(409.65,+LAST,0)),U,5) Q:LAST1
61 Q LAST
62BULL ; Bulletin for purge
63 N SDLN,SDMSG
64 K ^TMP("SDAMLBL",$J)
65 S SDLN=0,XMSUB="APPOINTMENT STATUS UPDATE LOG PURGE" K XMY
66 S XMTEXT="^TMP(""SDAMLBL"",$J,"
67 S XMY($S(DUZ:DUZ,1:.5))=""
68 S XMDUZ=.5 D NOW^%DTC
69 S SDMSG=" " D SETLN
70 S SDMSG="The Appointment Status Update Log Purge was completed "_$$FTIME^VALM1(%)_"." D SETLN
71 S SDMSG=" " D SETLN
72 S SDMSG=SDCNT_" records were purged from "_$$FDATE^VALM1(SDBD)_" to "_$$FDATE^VALM1(SDED)_"." D SETLN
73 D ^XMD
74 K ^TMP("SDAMLBL",$J),XMY,XMTEXT,XMSUB
75 Q
76 ;
77SETLN ; Setting TMP global for bulletin
78 S SDLN=SDLN+1
79 S ^TMP("SDAMLBL",$J,SDLN)=SDMSG
80 Q
81QUE() ; -- que job
82 ; return: did job que [ 1|yes 0|no ]
83 ;
84 K ZTSK,IO("Q")
85 S ZTIO="",ZTDESC="Appointment Update Log Status Purge",ZTRTN="EN4^SDAMLD"
86 F X="SDBD","SDED","SDMAX","DUZ" S ZTSAVE(X)=""
87 D ^%ZTLOAD W:$D(ZTSK) " (Task: ",ZTSK,")"
88 Q $D(ZTSK)
Note: See TracBrowser for help on using the repository browser.