DGQEBGR ;ALB/RPM - VIC REPLACEMENT BACKGROUND JOB PROCESSOR ; 1/2/2004
;;5.3;Registration;**571,1015**;Aug 13, 1993;Build 21
;
Q ;no direct entry
;
EN ;main entry point
;
D PURGE ;purge completed requests over 7 days old
D CKHOLD ;check "H"old status requests and update if needed
D SNDHL7 ;send queued HL7 messages
Q
;
PURGE ;purge completed VIC requests
; This subroutine deletes all VIC REQUEST (#39.6) records and their
; associated VIC HL7 TRANSMISSION LOG (#39.7) records for all VIC
; requests that fulfill the following conditions:
; 1. VIC request Card Print Release Status is not "H"old
; 2. VIC request is over 7 days old
; 3. Last HL7 transmission status associated with the request is
; an Accept acknowledgment
;
; Supported DBIA#: 10103 - $$FMADD^XLFDT, $$NOW^XLFDT
;
; Input: none
;
; Output: none
;
N DGSTAT ;card print release status
N DGCODT ;purge cutoff date
N DGIEN ;VIC REQUEST IEN
N DGLIEN ;VIC HL7 TRANSMISSION LOG IEN
N DGLOG ;VIC HL7 TRANSMISSION LOG data array
N DGRQDT ;VIC request date
;
S DGCODT=$$FMADD^XLFDT($$NOW^XLFDT(),-$$PRGDAYS())
F DGSTAT="C","I","P" D
. S DGRQDT=0
. F S DGRQDT=$O(^DGQE(39.6,"ASTAT",DGSTAT,DGRQDT)) Q:('DGRQDT!(DGRQDT>DGCODT)) D
. . S DGIEN=0
. . F S DGIEN=$O(^DGQE(39.6,"ASTAT",DGSTAT,DGRQDT,DGIEN)) Q:'DGIEN D
. . . S DGLIEN=$$FINDLST^DGQEHLL(DGIEN)
. . . I $$GETLOG^DGQEHLL(DGLIEN,.DGLOG),$G(DGLOG("XMSTAT"))="A" D
. . . . ;
. . . . ;delete the request and HL7 transmission records
. . . . I $$DELREQ^DGQEREQ(DGIEN)
;
Q
;
;
CKHOLD ;check all "H"old status requests for updates
; This subroutine evaluates the VIC eligibility for all VIC requests
; that have a "H"old Card Print Release Status and updates the Status
; if needed. When a VIC request retains a "H"old Card Print Release
; Status for more than the value returned by $$EXPDAYS^DGQEUT2(),
; the Card Print Release Status is changed to "C"ancel.
;
; Supported DBIA: #10103 - $$FMADD^XLFDT, $$NOW^XLFDT
;
; Input: none
;
; Output: none
;
N DGCODT ;cutoff date
N DGDAT ;request date
N DGELG ;eligibility data array
N DGIEN ;VIC REQUEST ien
N DGREQ ;VIC REQUEST data array
N DGSTAT ;card print release status
;
;set cutoff date for "H"old request expiration
S DGCODT=$$FMADD^XLFDT($$NOW^XLFDT(),-$$EXPDAYS)
S DGDAT=0
F S DGDAT=$O(^DGQE(39.6,"ASTAT","H",DGDAT)) Q:'DGDAT D
. S DGIEN=0
. F S DGIEN=$O(^DGQE(39.6,"ASTAT","H",DGDAT,DGIEN)) Q:'DGIEN D
. . ;drop out of block on first failure
. . ;
. . S DGSTAT=""
. . ;
. . ;get request record
. . Q:'$$GETREQ^DGQEREQ(DGIEN,.DGREQ)
. . Q:'$G(DGREQ("DFN"))
. . ;
. . ;build eligibility data array
. . Q:'$$GETELIG^DGQEUT1(DGREQ("DFN"),.DGELG)
. . S DGELG("ICN")=$$GETICN^DGQEDEMO(DGREQ("DFN")) ;add ICN to array
. . ;
. . ;re-evaluate Card Print Release Status
. . I $$HOLD^DGQEUT2(.DGELG) D
. . . ;
. . . ;set Status to "C"ancel when "H"old request expires
. . . I $G(DGREQ("REQDT"))>0,DGREQ("REQDT")<DGCODT S DGSTAT="C"
. . E D
. . . S DGSTAT=$S($$VICELIG^DGQEUT2(.DGELG):"P",1:"I")
. . ;
. . ;store status and queue HL7 message
. . I DGSTAT]"" D STOSTAT^DGQEREQ(DGIEN,DGSTAT)
;
Q
;
;
SNDHL7 ;send queued General Order (ORM~O01) HL7 messages to NCMD
; This subroutine transmits a General Order (ORM~O01) HL7 message
; to the National Card Management Directory for each entry in the
; "XMIT" index of the VIC REQUEST (#39.6) file.
;
; Input: none
;
; Output: none
;
N DGIEN
;
S DGIEN=0
F S DGIEN=$O(^DGQE(39.6,"AXMIT",DGIEN)) Q:'DGIEN D
. I $$SND^DGQEHLS(DGIEN)
Q
;
EXPDAYS() ;return VIC request expiration days
; This function returns the number of days that a pending VIC request
; is retained before being automatically cancelled. The value is
; contained in the PACKAGE ("PKG") entity of the DGQE VIC REQUEST
; EXPIRATION parameter.
;
; Input:
; none
;
; Output:
; Function value - DGQE VIC REQUEST EXPIRATION parameter [DEFAULT=90]
;
N DGVAL
S DGVAL=$$GET^XPAR("PKG","DGQE VIC REQUEST EXPIRATION",1,"Q")
Q $S(DGVAL="":90,1:DGVAL)
;
PRGDAYS() ;return VIC request purge days
; This function returns the number of days that a completed VIC request
; is retained before being purged. The value is contained in the
; PACKAGE ("PKG") entity of the DGQE VIC REQUEST PURGE parameter.
;
; Input:
; none
;
; Output:
; Function value - DGQE VIC REQUEST PURGE parameter [DEFAULT=7]
;
N DGVAL
S DGVAL=$$GET^XPAR("PKG","DGQE VIC REQUEST PURGE",1,"Q")
Q $S(DGVAL="":7,1:DGVAL)
DGQEBGR ;ALB/RPM - VIC REPLACEMENT BACKGROUND JOB PROCESSOR ; 1/2/2004
+1 ;;5.3;Registration;**571,1015**;Aug 13, 1993;Build 21
+2 ;
+3 ;no direct entry
QUIT
+4 ;
EN ;main entry point
+1 ;
+2 ;purge completed requests over 7 days old
DO PURGE
+3 ;check "H"old status requests and update if needed
DO CKHOLD
+4 ;send queued HL7 messages
DO SNDHL7
+5 QUIT
+6 ;
PURGE ;purge completed VIC requests
+1 ; This subroutine deletes all VIC REQUEST (#39.6) records and their
+2 ; associated VIC HL7 TRANSMISSION LOG (#39.7) records for all VIC
+3 ; requests that fulfill the following conditions:
+4 ; 1. VIC request Card Print Release Status is not "H"old
+5 ; 2. VIC request is over 7 days old
+6 ; 3. Last HL7 transmission status associated with the request is
+7 ; an Accept acknowledgment
+8 ;
+9 ; Supported DBIA#: 10103 - $$FMADD^XLFDT, $$NOW^XLFDT
+10 ;
+11 ; Input: none
+12 ;
+13 ; Output: none
+14 ;
+15 ;card print release status
NEW DGSTAT
+16 ;purge cutoff date
NEW DGCODT
+17 ;VIC REQUEST IEN
NEW DGIEN
+18 ;VIC HL7 TRANSMISSION LOG IEN
NEW DGLIEN
+19 ;VIC HL7 TRANSMISSION LOG data array
NEW DGLOG
+20 ;VIC request date
NEW DGRQDT
+21 ;
+22 SET DGCODT=$$FMADD^XLFDT($$NOW^XLFDT(),-$$PRGDAYS())
+23 FOR DGSTAT="C","I","P"
Begin DoDot:1
+24 SET DGRQDT=0
+25 FOR
SET DGRQDT=$ORDER(^DGQE(39.6,"ASTAT",DGSTAT,DGRQDT))
IF ('DGRQDT!(DGRQDT>DGCODT))
QUIT
Begin DoDot:2
+26 SET DGIEN=0
+27 FOR
SET DGIEN=$ORDER(^DGQE(39.6,"ASTAT",DGSTAT,DGRQDT,DGIEN))
IF 'DGIEN
QUIT
Begin DoDot:3
+28 SET DGLIEN=$$FINDLST^DGQEHLL(DGIEN)
+29 IF $$GETLOG^DGQEHLL(DGLIEN,.DGLOG)
IF $GET(DGLOG("XMSTAT"))="A"
Begin DoDot:4
+30 ;
+31 ;delete the request and HL7 transmission records
+32 IF $$DELREQ^DGQEREQ(DGIEN)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+33 ;
+34 QUIT
+35 ;
+36 ;
CKHOLD ;check all "H"old status requests for updates
+1 ; This subroutine evaluates the VIC eligibility for all VIC requests
+2 ; that have a "H"old Card Print Release Status and updates the Status
+3 ; if needed. When a VIC request retains a "H"old Card Print Release
+4 ; Status for more than the value returned by $$EXPDAYS^DGQEUT2(),
+5 ; the Card Print Release Status is changed to "C"ancel.
+6 ;
+7 ; Supported DBIA: #10103 - $$FMADD^XLFDT, $$NOW^XLFDT
+8 ;
+9 ; Input: none
+10 ;
+11 ; Output: none
+12 ;
+13 ;cutoff date
NEW DGCODT
+14 ;request date
NEW DGDAT
+15 ;eligibility data array
NEW DGELG
+16 ;VIC REQUEST ien
NEW DGIEN
+17 ;VIC REQUEST data array
NEW DGREQ
+18 ;card print release status
NEW DGSTAT
+19 ;
+20 ;set cutoff date for "H"old request expiration
+21 SET DGCODT=$$FMADD^XLFDT($$NOW^XLFDT(),-$$EXPDAYS)
+22 SET DGDAT=0
+23 FOR
SET DGDAT=$ORDER(^DGQE(39.6,"ASTAT","H",DGDAT))
IF 'DGDAT
QUIT
Begin DoDot:1
+24 SET DGIEN=0
+25 FOR
SET DGIEN=$ORDER(^DGQE(39.6,"ASTAT","H",DGDAT,DGIEN))
IF 'DGIEN
QUIT
Begin DoDot:2
+26 ;drop out of block on first failure
+27 ;
+28 SET DGSTAT=""
+29 ;
+30 ;get request record
+31 IF '$$GETREQ^DGQEREQ(DGIEN,.DGREQ)
QUIT
+32 IF '$GET(DGREQ("DFN"))
QUIT
+33 ;
+34 ;build eligibility data array
+35 IF '$$GETELIG^DGQEUT1(DGREQ("DFN"),.DGELG)
QUIT
+36 ;add ICN to array
SET DGELG("ICN")=$$GETICN^DGQEDEMO(DGREQ("DFN"))
+37 ;
+38 ;re-evaluate Card Print Release Status
+39 IF $$HOLD^DGQEUT2(.DGELG)
Begin DoDot:3
+40 ;
+41 ;set Status to "C"ancel when "H"old request expires
+42 IF $GET(DGREQ("REQDT"))>0
IF DGREQ("REQDT")<DGCODT
SET DGSTAT="C"
End DoDot:3
+43 IF '$TEST
Begin DoDot:3
+44 SET DGSTAT=$SELECT($$VICELIG^DGQEUT2(.DGELG):"P",1:"I")
End DoDot:3
+45 ;
+46 ;store status and queue HL7 message
+47 IF DGSTAT]""
DO STOSTAT^DGQEREQ(DGIEN,DGSTAT)
End DoDot:2
End DoDot:1
+48 ;
+49 QUIT
+50 ;
+51 ;
SNDHL7 ;send queued General Order (ORM~O01) HL7 messages to NCMD
+1 ; This subroutine transmits a General Order (ORM~O01) HL7 message
+2 ; to the National Card Management Directory for each entry in the
+3 ; "XMIT" index of the VIC REQUEST (#39.6) file.
+4 ;
+5 ; Input: none
+6 ;
+7 ; Output: none
+8 ;
+9 NEW DGIEN
+10 ;
+11 SET DGIEN=0
+12 FOR
SET DGIEN=$ORDER(^DGQE(39.6,"AXMIT",DGIEN))
IF 'DGIEN
QUIT
Begin DoDot:1
+13 IF $$SND^DGQEHLS(DGIEN)
End DoDot:1
+14 QUIT
+15 ;
EXPDAYS() ;return VIC request expiration days
+1 ; This function returns the number of days that a pending VIC request
+2 ; is retained before being automatically cancelled. The value is
+3 ; contained in the PACKAGE ("PKG") entity of the DGQE VIC REQUEST
+4 ; EXPIRATION parameter.
+5 ;
+6 ; Input:
+7 ; none
+8 ;
+9 ; Output:
+10 ; Function value - DGQE VIC REQUEST EXPIRATION parameter [DEFAULT=90]
+11 ;
+12 NEW DGVAL
+13 SET DGVAL=$$GET^XPAR("PKG","DGQE VIC REQUEST EXPIRATION",1,"Q")
+14 QUIT $SELECT(DGVAL="":90,1:DGVAL)
+15 ;
PRGDAYS() ;return VIC request purge days
+1 ; This function returns the number of days that a completed VIC request
+2 ; is retained before being purged. The value is contained in the
+3 ; PACKAGE ("PKG") entity of the DGQE VIC REQUEST PURGE parameter.
+4 ;
+5 ; Input:
+6 ; none
+7 ;
+8 ; Output:
+9 ; Function value - DGQE VIC REQUEST PURGE parameter [DEFAULT=7]
+10 ;
+11 NEW DGVAL
+12 SET DGVAL=$$GET^XPAR("PKG","DGQE VIC REQUEST PURGE",1,"Q")
+13 QUIT $SELECT(DGVAL="":7,1:DGVAL)
