IVMPTRN1.m

IVMPTRN1 ;ALB/MLI - Clock routine for testing only ; 04-MAY-93

 ;;2.0;INCOME VERIFICATION MATCH;**9**; 21-OCT-94

 ;;Per VHA Directive 10-93-142, this routine should not be modified.

 ;

 ;

START ; start clock                              remove after v1

 D NOW^%DTC S IVMBEG=%

 K %

 Q

 ;

 ;

STOP ; stop clock, mail bulletin                remove after v1

 N X,Y ; from DTC call

 I '$G(IVMGTOT) G STOPQ

 D NOW^%DTC S IVMEND=%

 S IVMTEXT(1)="The IVM bulk transmission has completed successfully.",IVMTEXT(2)=" "

 S IVMTEXT(3)="Start Time:                   "_IVMBEG

 S IVMTEXT(4)="End Time:                     "_IVMEND

 S IVMTEXT(5)="Number of Transmissions:      "_IVMGTOT

 X ^%ZOSF("UCI")

 S XMTEXT="IVMTEXT(",XMSUB="IVM BULK TRANSMISSION HAS COMPLETED"

 S XMDUZ=.5,XMY(DUZ)=""

 D ^XMD

STOPQ K IVMGBEG,IVMEND,IVMGTOT

 K XMTEXT,IVMTEXT,XMSUB,XMDUZ,XMY

 Q

 ;

 ;

DELMT ; send delete mt transaction if pt no longer meets IVM criteria

 ;

 ; Input - DFN

 ;         IVMMTDT - date of means test

 ;

 N I,IVMIY,X

 S IVMIY=$$LYR^DGMTSCU1(IVMMTDT)

 F I=1:1:5,8:1:14 S $P(X,HLFS,I)=HLQ

 S ^TMP("HLS",$J,HLSDT,IVMCT)="ZMT"_HLFS_X

 D CLOSE(IVMIY,DFN,2,3) ; set flag to stop future transmissions

 Q

 ;

 ;

CLOSE(IVMIY,DFN,IVMCS,IVMCR) ; Close IVM case record for a patient

 ; Input:    DFN  --  Pointer to the patient in file #2

 ;         IVMIY  --  Income year of the closed case

 ;         IVMCS  --  Closure source [1=IVM | 2=DHCP]

 ;         IVMCR  --  Pointer to the closure reason in file #301.93

 ;

 N DA,DIE,DR,X,Y,EVENTS,STATUS

 I '$G(IVMIY)!'$G(DFN)!'$G(IVMCS)!'$G(IVMCR) G CLOSEQ

 S IVMDELMT=1 ; flag indicates deletion

 S DA=$O(^IVM(301.5,"APT",+DFN,+IVMIY,0))

 I $G(^IVM(301.5,+DA,0))']"" G CLOSEQ

 ;

 ;don't want closing a case to stop transmission of an enrollment event

 S STATUS=1

 I ($$STATUS^IVMPLOG(+DA,.EVENTS)=0),EVENTS("ENROLL")=1 S STATUS=0

 ;

 D NOW^%DTC S DR=".03////"_STATUS_";.04////1;1.01////"_IVMCR_";1.02////"_IVMCS_";1.03////"_%

 S DIE="^IVM(301.5," D ^DIE

CLOSEQ Q

 ;

 ;

PSEUDO ; strip P from pseudo SSNs before transmitting to IVM

 ;

 N X

 S X=IVMPID_$G(IVMPID(1))

 S $P(X,HLFS,20)=$E($P(X,HLFS,20),1,9) ; remove P

 K IVMPID S IVMPID=$E(X,1,245)

 I $L(X)>245 S IVMPID(1)=$E(X,246,999)

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IVMPTRN1   2277     printed  Mar 13, 2025@21:06:28                                                                                                                                                                                                    Page 2

IVMPTRN1  ;ALB/MLI - Clock routine for testing only ; 04-MAY-93

 +1       ;;2.0;INCOME VERIFICATION MATCH;**9**; 21-OCT-94

 +2       ;;Per VHA Directive 10-93-142, this routine should not be modified.

 +3       ;

 +4       ;

START     ; start clock                              remove after v1

 +1        DO NOW^%DTC

           SET IVMBEG=%

 +2        KILL %

 +3        QUIT 

 +4       ;

 +5       ;

STOP      ; stop clock, mail bulletin                remove after v1

 +1       ; from DTC call

           NEW X,Y

 +2        IF '$GET(IVMGTOT)

               GOTO STOPQ

 +3        DO NOW^%DTC

           SET IVMEND=%

 +4        SET IVMTEXT(1)="The IVM bulk transmission has completed successfully."

           SET IVMTEXT(2)=" "

 +5        SET IVMTEXT(3)="Start Time:                   "_IVMBEG

 +6        SET IVMTEXT(4)="End Time:                     "_IVMEND

 +7        SET IVMTEXT(5)="Number of Transmissions:      "_IVMGTOT

 +8        XECUTE ^%ZOSF("UCI")

 +9        SET XMTEXT="IVMTEXT("

           SET XMSUB="IVM BULK TRANSMISSION HAS COMPLETED"

 +10       SET XMDUZ=.5

           SET XMY(DUZ)=""

 +11       DO ^XMD

STOPQ      KILL IVMGBEG,IVMEND,IVMGTOT

 +1        KILL XMTEXT,IVMTEXT,XMSUB,XMDUZ,XMY

 +2        QUIT 

 +3       ;

 +4       ;

DELMT     ; send delete mt transaction if pt no longer meets IVM criteria

 +1       ;

 +2       ; Input - DFN

 +3       ;         IVMMTDT - date of means test

 +4       ;

 +5        NEW I,IVMIY,X

 +6        SET IVMIY=$$LYR^DGMTSCU1(IVMMTDT)

 +7        FOR I=1:1:5,8:1:14

               SET $PIECE(X,HLFS,I)=HLQ

 +8        SET ^TMP("HLS",$JOB,HLSDT,IVMCT)="ZMT"_HLFS_X

 +9       ; set flag to stop future transmissions

           DO CLOSE(IVMIY,DFN,2,3)

 +10       QUIT 

 +11      ;

 +12      ;

CLOSE(IVMIY,DFN,IVMCS,IVMCR) ; Close IVM case record for a patient

 +1       ; Input:    DFN  --  Pointer to the patient in file #2

 +2       ;         IVMIY  --  Income year of the closed case

 +3       ;         IVMCS  --  Closure source [1=IVM | 2=DHCP]

 +4       ;         IVMCR  --  Pointer to the closure reason in file #301.93

 +5       ;

 +6        NEW DA,DIE,DR,X,Y,EVENTS,STATUS

 +7        IF '$GET(IVMIY)!'$GET(DFN)!'$GET(IVMCS)!'$GET(IVMCR)

               GOTO CLOSEQ

 +8       ; flag indicates deletion

           SET IVMDELMT=1

 +9        SET DA=$ORDER(^IVM(301.5,"APT",+DFN,+IVMIY,0))

 +10       IF $GET(^IVM(301.5,+DA,0))']""

               GOTO CLOSEQ

 +11      ;

 +12      ;don't want closing a case to stop transmission of an enrollment event

 +13       SET STATUS=1

 +14       IF ($$STATUS^IVMPLOG(+DA,.EVENTS)=0)

               IF EVENTS("ENROLL")=1

                   SET STATUS=0

 +15      ;

 +16       DO NOW^%DTC

           SET DR=".03////"_STATUS_";.04////1;1.01////"_IVMCR_";1.02////"_IVMCS_";1.03////"_%

 +17       SET DIE="^IVM(301.5,"

           DO ^DIE

CLOSEQ     QUIT 

 +1       ;

 +2       ;

PSEUDO    ; strip P from pseudo SSNs before transmitting to IVM

 +1       ;

 +2        NEW X

 +3        SET X=IVMPID_$GET(IVMPID(1))

 +4       ; remove P

           SET $PIECE(X,HLFS,20)=$EXTRACT($PIECE(X,HLFS,20),1,9)

 +5        KILL IVMPID

           SET IVMPID=$EXTRACT(X,1,245)

 +6        IF $LENGTH(X)>245

               SET IVMPID(1)=$EXTRACT(X,246,999)

 +7        QUIT