| 1 | IVMPTRN1 ;ALB/MLI - Clock routine for testing only ; 04-MAY-93
|
|---|
| 2 | ;;2.0;INCOME VERIFICATION MATCH;**9**; 21-OCT-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ;
|
|---|
| 6 | START ; start clock remove after v1
|
|---|
| 7 | D NOW^%DTC S IVMBEG=%
|
|---|
| 8 | K %
|
|---|
| 9 | Q
|
|---|
| 10 | ;
|
|---|
| 11 | ;
|
|---|
| 12 | STOP ; stop clock, mail bulletin remove after v1
|
|---|
| 13 | N X,Y ; from DTC call
|
|---|
| 14 | I '$G(IVMGTOT) G STOPQ
|
|---|
| 15 | D NOW^%DTC S IVMEND=%
|
|---|
| 16 | S IVMTEXT(1)="The IVM bulk transmission has completed successfully.",IVMTEXT(2)=" "
|
|---|
| 17 | S IVMTEXT(3)="Start Time: "_IVMBEG
|
|---|
| 18 | S IVMTEXT(4)="End Time: "_IVMEND
|
|---|
| 19 | S IVMTEXT(5)="Number of Transmissions: "_IVMGTOT
|
|---|
| 20 | X ^%ZOSF("UCI")
|
|---|
| 21 | S XMTEXT="IVMTEXT(",XMSUB="IVM BULK TRANSMISSION HAS COMPLETED"
|
|---|
| 22 | S XMDUZ=.5,XMY(DUZ)=""
|
|---|
| 23 | D ^XMD
|
|---|
| 24 | STOPQ K IVMGBEG,IVMEND,IVMGTOT
|
|---|
| 25 | K XMTEXT,IVMTEXT,XMSUB,XMDUZ,XMY
|
|---|
| 26 | Q
|
|---|
| 27 | ;
|
|---|
| 28 | ;
|
|---|
| 29 | DELMT ; send delete mt transaction if pt no longer meets IVM criteria
|
|---|
| 30 | ;
|
|---|
| 31 | ; Input - DFN
|
|---|
| 32 | ; IVMMTDT - date of means test
|
|---|
| 33 | ;
|
|---|
| 34 | N I,IVMIY,X
|
|---|
| 35 | S IVMIY=$$LYR^DGMTSCU1(IVMMTDT)
|
|---|
| 36 | F I=1:1:5,8:1:14 S $P(X,HLFS,I)=HLQ
|
|---|
| 37 | S ^TMP("HLS",$J,HLSDT,IVMCT)="ZMT"_HLFS_X
|
|---|
| 38 | D CLOSE(IVMIY,DFN,2,3) ; set flag to stop future transmissions
|
|---|
| 39 | Q
|
|---|
| 40 | ;
|
|---|
| 41 | ;
|
|---|
| 42 | CLOSE(IVMIY,DFN,IVMCS,IVMCR) ; Close IVM case record for a patient
|
|---|
| 43 | ; Input: DFN -- Pointer to the patient in file #2
|
|---|
| 44 | ; IVMIY -- Income year of the closed case
|
|---|
| 45 | ; IVMCS -- Closure source [1=IVM | 2=DHCP]
|
|---|
| 46 | ; IVMCR -- Pointer to the closure reason in file #301.93
|
|---|
| 47 | ;
|
|---|
| 48 | N DA,DIE,DR,X,Y,EVENTS,STATUS
|
|---|
| 49 | I '$G(IVMIY)!'$G(DFN)!'$G(IVMCS)!'$G(IVMCR) G CLOSEQ
|
|---|
| 50 | S IVMDELMT=1 ; flag indicates deletion
|
|---|
| 51 | S DA=$O(^IVM(301.5,"APT",+DFN,+IVMIY,0))
|
|---|
| 52 | I $G(^IVM(301.5,+DA,0))']"" G CLOSEQ
|
|---|
| 53 | ;
|
|---|
| 54 | ;don't want closing a case to stop transmission of an enrollment event
|
|---|
| 55 | S STATUS=1
|
|---|
| 56 | I ($$STATUS^IVMPLOG(+DA,.EVENTS)=0),EVENTS("ENROLL")=1 S STATUS=0
|
|---|
| 57 | ;
|
|---|
| 58 | D NOW^%DTC S DR=".03////"_STATUS_";.04////1;1.01////"_IVMCR_";1.02////"_IVMCS_";1.03////"_%
|
|---|
| 59 | S DIE="^IVM(301.5," D ^DIE
|
|---|
| 60 | CLOSEQ Q
|
|---|
| 61 | ;
|
|---|
| 62 | ;
|
|---|
| 63 | PSEUDO ; strip P from pseudo SSNs before transmitting to IVM
|
|---|
| 64 | ;
|
|---|
| 65 | N X
|
|---|
| 66 | S X=IVMPID_$G(IVMPID(1))
|
|---|
| 67 | S $P(X,HLFS,20)=$E($P(X,HLFS,20),1,9) ; remove P
|
|---|
| 68 | K IVMPID S IVMPID=$E(X,1,245)
|
|---|
| 69 | I $L(X)>245 S IVMPID(1)=$E(X,246,999)
|
|---|
| 70 | Q
|
|---|
