IVMPINS ;ALB/CPM,PHH - INSURANCE EVENT DRIVER INTERFACE ; 01-MAY-94
;;2.0;INCOME VERIFICATION MATCH;**9,94**; 21-OCT-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
EN ; Queue transmission if an IVM patient's insurance status changes.
; Input: DFN -- Pointer to the patient in file #2
;
N EVENTS
S EVENTS("IVM")=1
;
I '$G(DFN) G ENQ
;
; - quit if invoked by the IVM insurance upload process
I $G(IVMINSUP) G ENQ
;
; - quit if the patient is not Cat C or Cat A
S IVMMT=$$LST^DGMTU(DFN)
I $P(IVMMT,"^",4)'="A",$P(IVMMT,"^",4)'="C" G ENQ
;
; - find the latest IVM case record, if it exists
S (IVMDA,IVMDT,X)=0
F S X=$O(^IVM(301.5,"APT",DFN,X)) Q:'X S IVMDT=X
I IVMDT S IVMDA=+$O(^IVM(301.5,"APT",DFN,IVMDT,0))
S IVMNEW='IVMDA
;
; - determine changes in insurance status
S IVMINSP=$$PRIOR(IVMDA)
S IVMINSA=$$INSUR^IBBAPI(DFN)
;
; - queue transmission if status has changed
I IVMDA,(IVMINSP&'IVMINSA)!('IVMINSP&IVMINSA=1) I $$SETSTAT^IVMPLOG(IVMDA,.EVENTS)
;
; - queue transmission if Cat C pt w/o a case record has no insurance
I 'IVMDA,'IVMINSA,$P(IVMMT,"^",4)="C" S IVMDT=$$LYR^DGMTSCU1(+$P(IVMMT,"^",2)) I $$LOG^IVMPLOG(DFN,IVMDT,.EVENTS)
;
ENQ K IVMDA,IVMDT,IVMINSA,IVMINSP,IVMMT,IVMNEW,X
Q
;
;
PRIOR(DA) ; Find insurance status from last transmission
; Input: DA -- Pointer to the case record in file #301.5
; Output: 0 -- No active insurance at last transmission
; (or could not identify last transmission)
; 1 -- Had active insurance at last transmission
;
N X,Y S (X,Y)=0
I $G(DA) F S Y=$O(^IVM(301.6,"B",DA,Y)) Q:'Y S X=Y
Q $S(X:+$P($G(^IVM(301.6,X,1)),"^",2),1:0)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVMPINS 1722 printed Oct 16, 2024@18:02:52 Page 2
IVMPINS ;ALB/CPM,PHH - INSURANCE EVENT DRIVER INTERFACE ; 01-MAY-94
+1 ;;2.0;INCOME VERIFICATION MATCH;**9,94**; 21-OCT-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
EN ; Queue transmission if an IVM patient's insurance status changes.
+1 ; Input: DFN -- Pointer to the patient in file #2
+2 ;
+3 NEW EVENTS
+4 SET EVENTS("IVM")=1
+5 ;
+6 IF '$GET(DFN)
GOTO ENQ
+7 ;
+8 ; - quit if invoked by the IVM insurance upload process
+9 IF $GET(IVMINSUP)
GOTO ENQ
+10 ;
+11 ; - quit if the patient is not Cat C or Cat A
+12 SET IVMMT=$$LST^DGMTU(DFN)
+13 IF $PIECE(IVMMT,"^",4)'="A"
IF $PIECE(IVMMT,"^",4)'="C"
GOTO ENQ
+14 ;
+15 ; - find the latest IVM case record, if it exists
+16 SET (IVMDA,IVMDT,X)=0
+17 FOR
SET X=$ORDER(^IVM(301.5,"APT",DFN,X))
if 'X
QUIT
SET IVMDT=X
+18 IF IVMDT
SET IVMDA=+$ORDER(^IVM(301.5,"APT",DFN,IVMDT,0))
+19 SET IVMNEW='IVMDA
+20 ;
+21 ; - determine changes in insurance status
+22 SET IVMINSP=$$PRIOR(IVMDA)
+23 SET IVMINSA=$$INSUR^IBBAPI(DFN)
+24 ;
+25 ; - queue transmission if status has changed
+26 IF IVMDA
IF (IVMINSP&'IVMINSA)!('IVMINSP&IVMINSA=1)
IF $$SETSTAT^IVMPLOG(IVMDA,.EVENTS)
+27 ;
+28 ; - queue transmission if Cat C pt w/o a case record has no insurance
+29 IF 'IVMDA
IF 'IVMINSA
IF $PIECE(IVMMT,"^",4)="C"
SET IVMDT=$$LYR^DGMTSCU1(+$PIECE(IVMMT,"^",2))
IF $$LOG^IVMPLOG(DFN,IVMDT,.EVENTS)
+30 ;
ENQ KILL IVMDA,IVMDT,IVMINSA,IVMINSP,IVMMT,IVMNEW,X
+1 QUIT
+2 ;
+3 ;
PRIOR(DA) ; Find insurance status from last transmission
+1 ; Input: DA -- Pointer to the case record in file #301.5
+2 ; Output: 0 -- No active insurance at last transmission
+3 ; (or could not identify last transmission)
+4 ; 1 -- Had active insurance at last transmission
+5 ;
+6 NEW X,Y
SET (X,Y)=0
+7 IF $GET(DA)
FOR
SET Y=$ORDER(^IVM(301.6,"B",DA,Y))
if 'Y
QUIT
SET X=Y
+8 QUIT $SELECT(X:+$PIECE($GET(^IVM(301.6,X,1)),"^",2),1:0)
