IVMPINS.m

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 ---IVMPINS   1722     printed  Sep 02, 2024@18:47:26                                                                                                                                                                                                     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)