source: WorldVistAEHR/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVMPTRN1.m@ 1739

Last change on this file since 1739 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.2 KB
RevLine 
[613]1IVMPTRN1 ;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 ;
6START ; start clock remove after v1
7 D NOW^%DTC S IVMBEG=%
8 K %
9 Q
10 ;
11 ;
12STOP ; 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
24STOPQ K IVMGBEG,IVMEND,IVMGTOT
25 K XMTEXT,IVMTEXT,XMSUB,XMDUZ,XMY
26 Q
27 ;
28 ;
29DELMT ; 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 ;
42CLOSE(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
60CLOSEQ Q
61 ;
62 ;
63PSEUDO ; 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
Note: See TracBrowser for help on using the repository browser.