source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SD5384NC.m@ 658

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

initial load of FOIAVistA 6/30/08 version

File size: 3.5 KB
Line 
1SD5384NC ;ALB/MLI - Non-count encounter cleanup ; January 13, 1996
2 ;;5.3;Scheduling;**84**;AUG 13, 1993
3 ;
4 ; This routine will update encounters to be non-count for locations
5 ; selected. It was written to correct problems caused when clinics
6 ; were changed to non-count after 10/1/96. It will also delete any
7 ; related entries from the Transmitted Outpatient Encounter file.
8 ;
9 ; To run, call the routine from the top (D ^SD5384NC). You will be
10 ; asked for one or more hospital location entries which are set-up
11 ; as non-count. You will be asked for a date range where you can
12 ; select beginning 10/1/96 and ending today's date. It is STRONGLY
13 ; recommended that you select the range where the problem actually
14 ; occurred to reduce the amount of processing this routine will
15 ; have to do. For example, if you changed the locations to non-count
16 ; on 11/4/96, enter 11/4/96 as your end date.
17 ;
18EN ; ask questions, queue process
19 N DIROUT,DIRUT,DTOUT,DUOUT,RANGE,SDBEG,SDEND,SDLOC
20 D GETLOC(.SDLOC) I '$O(SDLOC(0)) G ENQ
21 W ! S RANGE=$$GETDTRNG^SCDXUTL1(2961001,$P($$NOW^XLFDT(),".",1)) I RANGE<0 G ENQ
22 S SDBEG=$P(RANGE,"^"),SDEND=$P(RANGE,"^",2)
23 D QUEUE ; to queue process
24 ;D DQ ; for testing
25ENQ Q
26 ;
27 ;
28GETLOC(ARRAY) ; get list of location(s)
29 S DIC="^SC(",DIC("S")="I $P(^(0),""^"",17)=""Y"""
30 S VAUTSTR="clinic",VAUTNI=2,VAUTVB="ARRAY",VAUTNALL=1
31 D FIRST^VAUTOMA
32 Q
33 ;
34 ;
35QUEUE ; queue job
36 N I,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK
37 S ZTIO="",ZTDESC="Reset non-count encounters",ZTRTN="DQ^SD5384NC"
38 F I="SDLOC(","SDBEG","SDEND" S ZTSAVE(I)=""
39 D ^%ZTLOAD
40 I $G(ZTSK) W !,"Task queued: #",ZTSK
41 Q
42 ;
43 ;
44DQ ; dequeue point...collect results and generate message.
45 N SDCOUNT,SDSTART
46 S SDSTART=$$NOW^XLFDT()
47 S SDCOUNT=0
48 D COLLECT
49 D RESULTS
50 Q
51 ;
52 ;
53COLLECT ; collect data
54 N OK,SDI,SDJ,SDX
55 F SDI=SDBEG:0 S SDI=$O(^SCE("B",SDI)) Q:'SDI!(SDI>(SDEND+.9)) D
56 . F SDJ=0:0 S SDJ=$O(^SCE("B",SDI,SDJ)) Q:'SDJ D
57 . . ;
58 . . S SDX=$G(^SCE(SDJ,0)) I 'SDX Q ; no 0 node
59 . . S SDLOC=+$P(SDX,"^",4) ; location of encounter
60 . . I '$D(SDLOC(SDLOC)) Q ; not for a selected location
61 . . I $P(SDX,"^",6) Q ; child encounter
62 . . I $P(SDX,"^",12)=12 Q ; not non-count
63 . . ;
64 . . D FILE("^SCE(",SDJ,".12////12") ; file as non-count
65 . . D EN^SDCOM(SDJ,0,,.ERROR) ; call to update check-out
66 . . S OK=$$DELXMIT^SCDXFU03(SDJ,1) ; delete trans outpt enc entry
67 . . ;
68 . . S $P(SDLOC(SDLOC),"^",2)=$P(SDLOC(SDLOC),"^",2)+1 ; increment counter by location
69 Q
70 ;
71 ;
72FILE(DIE,DA,DR) ; update entry defined in DA in file DIE with DR string
73 N X,Y
74 D ^DIE
75 Q
76 ;
77 ;
78RESULTS ; generate an e-mail bulletin when done
79 N DIFROM,I,LINE,X
80 S SDCOUNT=0
81 D LINE("The Non-count Encounter cleanup has run to completion."),LINE("")
82 D LINE(" Start Time: "_$$FMTE^XLFDT(SDSTART))
83 D LINE(" End Time: "_$$FMTE^XLFDT($$NOW^XLFDT())),LINE("")
84 F I=0:0 S I=$O(SDLOC(I)) Q:'I D
85 . S X=+$P(SDLOC(I),"^",2)
86 . I X=1 S LINE="1 entry"
87 . I X=0 S LINE="No entries"
88 . I X>1 S LINE=X_" entries"
89 . S LINE=LINE_" updated to be non-count for "_$P(SDLOC(I),"^",1)_" clinic (IEN #"_I_")"
90 . D LINE(LINE)
91 S XMSUB="Non-count Encounter Cleanup is Complete",XMN=0
92 S XMTEXT="SDTEXT("
93 S XMDUZ=.5,XMY(DUZ)=""
94 D ^XMD
95 K SDCOUNT,SDTEXT,XMDUZ,XMN,XMSUB,XMTEXT,XMY
96 Q
97 ;
98 ;
99LINE(TEXT) ; add text to mail message
100 S SDCOUNT=SDCOUNT+1,SDTEXT(SDCOUNT)=TEXT
101 Q
Note: See TracBrowser for help on using the repository browser.