71 lines
2.2 KiB
Mathematica
71 lines
2.2 KiB
Mathematica
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
|