source: FOIAVistA/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGQEBGR.m@ 1713

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

initial load of FOIAVistA 6/30/08 version
File size: 4.4 KB
Line 
1DGQEBGR ;ALB/RPM - VIC REPLACEMENT BACKGROUND JOB PROCESSOR ; 1/2/2004
2 ;;5.3;Registration;**571**;Aug 13, 1993
3 ;
4 Q ;no direct entry
5 ;
6EN ;main entry point
7 ;
8 D PURGE ;purge completed requests over 7 days old
9 D CKHOLD ;check "H"old status requests and update if needed
10 D SNDHL7 ;send queued HL7 messages
11 Q
12 ;
13PURGE ;purge completed VIC requests
14 ; This subroutine deletes all VIC REQUEST (#39.6) records and their
15 ; associated VIC HL7 TRANSMISSION LOG (#39.7) records for all VIC
16 ; requests that fulfill the following conditions:
17 ; 1. VIC request Card Print Release Status is not "H"old
18 ; 2. VIC request is over 7 days old
19 ; 3. Last HL7 transmission status associated with the request is
20 ; an Accept acknowledgment
21 ;
22 ; Supported DBIA#: 10103 - $$FMADD^XLFDT, $$NOW^XLFDT
23 ;
24 ; Input: none
25 ;
26 ; Output: none
27 ;
28 N DGSTAT ;card print release status
29 N DGCODT ;purge cutoff date
30 N DGIEN ;VIC REQUEST IEN
31 N DGLIEN ;VIC HL7 TRANSMISSION LOG IEN
32 N DGLOG ;VIC HL7 TRANSMISSION LOG data array
33 N DGRQDT ;VIC request date
34 ;
35 S DGCODT=$$FMADD^XLFDT($$NOW^XLFDT(),-$$PRGDAYS())
36 F DGSTAT="C","I","P" D
37 . S DGRQDT=0
38 . F S DGRQDT=$O(^DGQE(39.6,"ASTAT",DGSTAT,DGRQDT)) Q:('DGRQDT!(DGRQDT>DGCODT)) D
39 . . S DGIEN=0
40 . . F S DGIEN=$O(^DGQE(39.6,"ASTAT",DGSTAT,DGRQDT,DGIEN)) Q:'DGIEN D
41 . . . S DGLIEN=$$FINDLST^DGQEHLL(DGIEN)
42 . . . I $$GETLOG^DGQEHLL(DGLIEN,.DGLOG),$G(DGLOG("XMSTAT"))="A" D
43 . . . . ;
44 . . . . ;delete the request and HL7 transmission records
45 . . . . I $$DELREQ^DGQEREQ(DGIEN)
46 ;
47 Q
48 ;
49 ;
50CKHOLD ;check all "H"old status requests for updates
51 ; This subroutine evaluates the VIC eligibility for all VIC requests
52 ; that have a "H"old Card Print Release Status and updates the Status
53 ; if needed. When a VIC request retains a "H"old Card Print Release
54 ; Status for more than the value returned by $$EXPDAYS^DGQEUT2(),
55 ; the Card Print Release Status is changed to "C"ancel.
56 ;
57 ; Supported DBIA: #10103 - $$FMADD^XLFDT, $$NOW^XLFDT
58 ;
59 ; Input: none
60 ;
61 ; Output: none
62 ;
63 N DGCODT ;cutoff date
64 N DGDAT ;request date
65 N DGELG ;eligibility data array
66 N DGIEN ;VIC REQUEST ien
67 N DGREQ ;VIC REQUEST data array
68 N DGSTAT ;card print release status
69 ;
70 ;set cutoff date for "H"old request expiration
71 S DGCODT=$$FMADD^XLFDT($$NOW^XLFDT(),-$$EXPDAYS)
72 S DGDAT=0
73 F S DGDAT=$O(^DGQE(39.6,"ASTAT","H",DGDAT)) Q:'DGDAT D
74 . S DGIEN=0
75 . F S DGIEN=$O(^DGQE(39.6,"ASTAT","H",DGDAT,DGIEN)) Q:'DGIEN D
76 . . ;drop out of block on first failure
77 . . ;
78 . . S DGSTAT=""
79 . . ;
80 . . ;get request record
81 . . Q:'$$GETREQ^DGQEREQ(DGIEN,.DGREQ)
82 . . Q:'$G(DGREQ("DFN"))
83 . . ;
84 . . ;build eligibility data array
85 . . Q:'$$GETELIG^DGQEUT1(DGREQ("DFN"),.DGELG)
86 . . S DGELG("ICN")=$$GETICN^DGQEDEMO(DGREQ("DFN")) ;add ICN to array
87 . . ;
88 . . ;re-evaluate Card Print Release Status
89 . . I $$HOLD^DGQEUT2(.DGELG) D
90 . . . ;
91 . . . ;set Status to "C"ancel when "H"old request expires
92 . . . I $G(DGREQ("REQDT"))>0,DGREQ("REQDT")<DGCODT S DGSTAT="C"
93 . . E D
94 . . . S DGSTAT=$S($$VICELIG^DGQEUT2(.DGELG):"P",1:"I")
95 . . ;
96 . . ;store status and queue HL7 message
97 . . I DGSTAT]"" D STOSTAT^DGQEREQ(DGIEN,DGSTAT)
98 ;
99 Q
100 ;
101 ;
102SNDHL7 ;send queued General Order (ORM~O01) HL7 messages to NCMD
103 ; This subroutine transmits a General Order (ORM~O01) HL7 message
104 ; to the National Card Management Directory for each entry in the
105 ; "XMIT" index of the VIC REQUEST (#39.6) file.
106 ;
107 ; Input: none
108 ;
109 ; Output: none
110 ;
111 N DGIEN
112 ;
113 S DGIEN=0
114 F S DGIEN=$O(^DGQE(39.6,"AXMIT",DGIEN)) Q:'DGIEN D
115 . I $$SND^DGQEHLS(DGIEN)
116 Q
117 ;
118EXPDAYS() ;return VIC request expiration days
119 ; This function returns the number of days that a pending VIC request
120 ; is retained before being automatically cancelled. The value is
121 ; contained in the PACKAGE ("PKG") entity of the DGQE VIC REQUEST
122 ; EXPIRATION parameter.
123 ;
124 ; Input:
125 ; none
126 ;
127 ; Output:
128 ; Function value - DGQE VIC REQUEST EXPIRATION parameter [DEFAULT=90]
129 ;
130 N DGVAL
131 S DGVAL=$$GET^XPAR("PKG","DGQE VIC REQUEST EXPIRATION",1,"Q")
132 Q $S(DGVAL="":90,1:DGVAL)
133 ;
134PRGDAYS() ;return VIC request purge days
135 ; This function returns the number of days that a completed VIC request
136 ; is retained before being purged. The value is contained in the
137 ; PACKAGE ("PKG") entity of the DGQE VIC REQUEST PURGE parameter.
138 ;
139 ; Input:
140 ; none
141 ;
142 ; Output:
143 ; Function value - DGQE VIC REQUEST PURGE parameter [DEFAULT=7]
144 ;
145 N DGVAL
146 S DGVAL=$$GET^XPAR("PKG","DGQE VIC REQUEST PURGE",1,"Q")
147 Q $S(DGVAL="":7,1:DGVAL)
Note: See TracBrowser for help on using the repository browser.