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 ---[H[J[2J[HIVMPTRN1 2277 printed Apr 09, 2024@21:02:16 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
