source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SD5384PT.m@ 1445

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

initial load of FOIAVistA 6/30/08 version
File size: 5.3 KB
Line 
1SD5384PT ;ALB/MLI - clean-up routine to remove credit stop code encounters ; 12 Dec 96 @ 10:02
2 ;;5.3;Scheduling;**84**;AUG 13, 1993
3 ;
4 ; This routine will loop through the Outpatient Encounter file for a date range and
5 ; look for credit stop codes which are:
6 ;
7 ; a. associated with location where the stop code is the same as the
8 ; credit stop code.
9 ;
10 ; b. associated with a non-count clinic.
11 ;
12 ; Credit stop code encounters (originating process = 4) found which meet one of
13 ; the above criteria will be deleted.
14 ;
15 ; The variables SDBEGDT and SDENDDT can be set prior to calling EN if a date range
16 ; other than 10/1/96 through the present is desired. The process will be queued
17 ; and a mail message of findings will be sent.
18 ;
19 ; If SDNODEL is defined, no data will be deleted.
20 ;
21 ;
22EN ; process task
23 N SDCOUNT,SDSTART
24 S SDSTART=$$NOW^XLFDT()
25 D LOOP ; loop through entries and delete
26 D MAIL ; build mail message of results
27 Q
28 ;
29 ;
30LOOP ; loop through encounter file and delete bogus credit stop entries
31 ;
32 ; Input Variables (all optional):
33 ; SDBEGDT = Beginning date of encounter search (default 2961001)
34 ; SDENDDT = Ending date of encounter search (default DT)
35 ; SDCLINIC = array of specific locations to look at (otherwise all)
36 ; SDNODEL = 1 if data should not be deleted during run
37 ;
38 ; Variables used:
39 ; SDALL = 1 if all clinics searched...otherwise 0
40 ; SDDATE = loop counter for encounter date
41 ; SDENC = loop counter for IEN of outpt encounter file
42 ; SDNODE = 0 node of ^SCE
43 ; SDCRED = credit stop code pointer
44 ; SDCOUNT = counter, subscripted by location IEN, of deleted credit
45 ; stop code encounters
46 ;
47 N SDALL,SDCRED,SDDATE,SDENC,SDNODE,SDPAR
48 S SDBEGDT=$G(SDBEGDT,2961001),SDENDDT=$G(SDENDDT,DT)+.9
49 S SDALL='$O(SDCLINIC(0)),SDDATE=SDBEGDT-.1
50 F S SDDATE=$O(^SCE("B",SDDATE)) Q:'SDDATE!(SDDATE>SDENDDT) D
51 . S SDENC=""
52 . F S SDENC=$O(^SCE("B",SDDATE,SDENC)) Q:'SDENC D
53 . . S SDNODE=$G(^SCE(SDENC,0))
54 . . I $P(SDNODE,"^",8)'=4 Q ; not a credit stop encounter
55 . . I 'SDALL D Q ; if only select clinics chosen
56 . . . I $D(SDCLINIC(+$P(SDNODE,"^",4))) D DEL(SDENC) ; delete credit associated with location
57 . . S SDCRED=$P(SDNODE,"^",3)
58 . . S SDPAR=$G(^SCE(+$P(SDNODE,"^",6),0)) ; get parent encounter
59 . . I $P(SDPAR,"^",12)=12 D DEL(SDENC) Q ; delete credit for non-counts
60 . . I SDCRED=$P(SDPAR,"^",3) D DEL(SDENC) Q ; delete if credit stop = stop
61LOOPQ Q
62 ;
63 ;
64DEL(IEN) ; delete encounter and increment counter by location
65 ;
66 ; Input - IEN of Outpatient Encounter file
67 ;
68 N DA,DIK,LOC
69 S LOC=$P($G(^SCE(IEN,0)),"^",4)
70 S SDCOUNT(LOC)=$G(SDCOUNT(LOC))+1
71 S DIK="^SCE("
72 S DA=IEN
73 I '$G(SDNODEL) D ^DIK
74 Q
75 ;
76 ;
77MAIL ; send bulletin of results
78 N DIFROM,SDTEXT
79 S SDCOUNT=0
80 D LINE("The Credit Stop Code Encounter clean-up has run to completion at "_$P($$SITE^VASITE(),"^",2)_"."),LINE("")
81 D LINE(" Start Time: "_$$FMTE^XLFDT(SDSTART))
82 D LINE(" End Time: "_$$FMTE^XLFDT($$NOW^XLFDT())),LINE("")
83 I '$O(SDCLINIC(0)) D
84 . D LINE("Credit stop code encounters for all clinics were deleted IF either:")
85 . D LINE(" a. the credit stop code associated with the clinic was equal")
86 . D LINE(" to the stop code associated with the clinic.")
87 . D LINE(" b. the clinic was set up as NON-COUNT.")
88 . D LINE("")
89 . D LINE("The following is a list of clinics for which credit stop code")
90 . D LINE("encounters were deleted:")
91 . F I=0:0 S I=$O(SDCOUNT(I)) Q:'I D LINE(" #"_I_" - "_$P($G(^SC(I,0)),"^",1)_"..."_+SDCOUNT(I)_" encounters deleted")
92 . I '$O(SDCOUNT(0)) D LINE(" No credit stop code encounters were found meeting the above criteria.")
93 E D
94 . D LINE("Credit stop code encounters were deleted for the following")
95 . D LINE("Hospital Locations:")
96 . F I=0:0 S I=$O(SDCLINIC(I)) Q:'I D LINE(" #"_I_" - "_$P($G(^SC(I,0)),"^",1)_"..."_+$G(SDCOUNT(I))_" encounters deleted")
97 S XMSUB="Credit Stop Code Encounter Clean-up is Complete",XMN=0
98 S XMTEXT="SDTEXT("
99 S XMDUZ=.5,XMY(DUZ)=""
100 D ^XMD
101 K XMDUZ,XMN,XMSUB,XMTEXT,XMY
102 Q
103 ;
104 ;
105LINE(TEXT) ; add text to mail message
106 S SDCOUNT=SDCOUNT+1,SDTEXT(SDCOUNT)=TEXT
107 Q
108 ;
109 ;
110CLINIC ; entry point if a site wants to delete ALL credit stop encounters associated with one (or more) hospital location(s)
111 ;
112 ; do not use without consulting customer support or development first...
113 ;
114 N SDCLINIC
115 S VAUTVB="SDCLINIC",VAUTSTR="clinic",VAUTNALL=1,VAUTNI=2
116 S DIC="^SC(",DIC("S")="I $P(^(0),U,3)=""C"""
117 D FIRST^VAUTOMA
118 I Y'<0 W !!,"Queuing credit stop encounter cleanup:" D QUEUE
119 D RETRAN
120 Q
121 ;
122 ;
123QUEUE ; queue process to run
124 N I
125 S ZTDESC="Credit stop code encounter clean-up process"
126 S ZTIO=""
127 F I="SDBEGDT","SDENDDT","SDCLINIC","SDNODEL" S ZTSAVE(I)=""
128 S ZTRTN="EN^SD5384PT"
129 D ^%ZTLOAD
130 I $D(ZTSK) W !,"Task number = ",ZTSK
131 K ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK
132 Q
133 ;
134 ;
135RETRAN ; flag errors of one type to retransmit
136 N DTOUT,DIROUT,DIRUT,DUOUT,ERROR,X,Y,DIR,SDLOOP
137 S DIR(0)="P^409.76:AQEMZ"
138 D ^DIR
139 I Y'>0 Q
140 S ERROR=+Y,SDLOOP=0
141 F S SDLOOP=$O(^SD(409.75,SDLOOP)) Q:'SDLOOP S X=$G(^(SDLOOP,0)) D
142 . I $P(X,"^",2)=ERROR D XMITFLAG^SCDXFU01(+X,0)
143 Q
Note: See TracBrowser for help on using the repository browser.