- 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 Mar 13, 2025@21:06:11 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)
