IVM2152P ;ALB/LBD - Patch IVM*2*152 Post-Install Routine ; 3/28/12 1:36pm
;;2.0;INCOME VERIFICATION MATCH;**152**;21-OCT-94;Build 4
;
;This routine will add new entries to the IVM DEMOGRAPHIC UPLOAD
;FIELDS file #301.92
Q
;
EP ;Entry point - Driver
N ABORT,FILE,I,ELEMNT,EXIST,IVMDATA,DATA,SUB,J,VALUE,FILEFLG,DIERR,ERROR
;
S (ABORT,FILEFLG)=0,FILE=301.92
F I=1:1 S ELEMNT=$P($T(TEXT+I),";;",2) Q:ELEMNT="QUIT"!(ABORT) D
. S EXIST=0
. K IVMDATA S (DATA,SUB)="" F J=1:1:$L(ELEMNT,";") S DATA=$P(ELEMNT,";",J) D Q:EXIST
. . S SUB=$P(DATA,"~",1),VALUE=$P(DATA,"~",2),IVMDATA(SUB)=VALUE
. . I SUB=.01 S EXIST=$$FIND1^DIC(FILE,,,IVMDATA(.01))
. I 'EXIST D
. . S FILEFLG=$$ADD(FILE,.IVMDATA)
. . I FILEFLG D MES^XPDUTL("Added - "_$G(IVMDATA(.01)))
. . I 'FILEFLG D
. . . S ABORT=1,XPDABORT=2
. . . D BMES^XPDUTL("Install process could not add an entry in file for "_$G(IVMDATA(.01)))
. . . D BMES^XPDUTL(" <<<< INSTALLATION ABORTED >>>>")
I 'ABORT D BMES^XPDUTL("<<<< Post Install Successful >>>>")
Q
;
ADD(FILE,DATA) ;
;Description: Creates a new record and files the data.
; Input:
; FILE - File or sub-file number
; DATA - Data array to file, pass by reference
; Format: DATA(<field #>)=<value>
;
; Output:
; Function Value - If no error then it returns the ien of the created record, else returns NULL.
;
N FDA,FIELD,IEN,IENA,IENS,IVMDA,ERRORS
;
;IENS - Internal Entry Number String defined by FM
;IENA - the Internal Entry Number Array defined by FM
;FDA - the FDA array defined by FM
;IEN - the ien of the new record
;
S IVMDA="+1"
S IENS=$$IENS^DILF(.IVMDA)
S FIELD=0
F S FIELD=$O(DATA(FIELD)) Q:'FIELD D
.S FDA(FILE,IENS,FIELD)=$G(DATA(FIELD))
I $G(IEN) S IENA(1)=IEN
D UPDATE^DIE("","FDA","IENA","ERRORS(1)")
I +$G(DIERR) D
.S ERROR=$G(ERRORS(1,"DIERR",1,"TEXT",1))
.S IEN=""
E D
.S IEN=IENA(1)
.S ERROR=""
D CLEAN^DILF
Q IEN
;
TEXT ;;FIELD#~VALUE;FIELD#~VALUE;FIELD#~VALUE.....
;;.01~RESIDENCE NUMBER CHANGE DT/TM;.02~RF171P;.03~1;.04~2;.05~.1321;.06~1;.07~1;.08~1;10~S DR=.1321 D LOOK^IVMPREC9;20~S DR=.1321 D LOOK^IVMPREC9
;;.01~RESIDENCE NUMBER CHANGE SOURCE;.02~RF162P;.03~1;.04~2;.05~.1322;.06~1;.07~1;.08~1;10~S DR=.1322 D LOOK^IVMPREC9;20~S DR=.1322 D LOOK^IVMPREC9
;;.01~RESIDENCE NUMBER CHANGE SITE;.02~RF161P;.03~1;.04~2;.05~.1323;.06~1;.07~1;.08~1;10~S DR=.1323 D LOOK^IVMPREC9;20~S DR=.1323 D LOOK^IVMPREC9
;;QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVM2152P 2497 printed Apr 09, 2024@21:03:23 Page 2
IVM2152P ;ALB/LBD - Patch IVM*2*152 Post-Install Routine ; 3/28/12 1:36pm
+1 ;;2.0;INCOME VERIFICATION MATCH;**152**;21-OCT-94;Build 4
+2 ;
+3 ;This routine will add new entries to the IVM DEMOGRAPHIC UPLOAD
+4 ;FIELDS file #301.92
+5 QUIT
+6 ;
EP ;Entry point - Driver
+1 NEW ABORT,FILE,I,ELEMNT,EXIST,IVMDATA,DATA,SUB,J,VALUE,FILEFLG,DIERR,ERROR
+2 ;
+3 SET (ABORT,FILEFLG)=0
SET FILE=301.92
+4 FOR I=1:1
SET ELEMNT=$PIECE($TEXT(TEXT+I),";;",2)
if ELEMNT="QUIT"!(ABORT)
QUIT
Begin DoDot:1
+5 SET EXIST=0
+6 KILL IVMDATA
SET (DATA,SUB)=""
FOR J=1:1:$LENGTH(ELEMNT,";")
SET DATA=$PIECE(ELEMNT,";",J)
Begin DoDot:2
+7 SET SUB=$PIECE(DATA,"~",1)
SET VALUE=$PIECE(DATA,"~",2)
SET IVMDATA(SUB)=VALUE
+8 IF SUB=.01
SET EXIST=$$FIND1^DIC(FILE,,,IVMDATA(.01))
End DoDot:2
if EXIST
QUIT
+9 IF 'EXIST
Begin DoDot:2
+10 SET FILEFLG=$$ADD(FILE,.IVMDATA)
+11 IF FILEFLG
DO MES^XPDUTL("Added - "_$GET(IVMDATA(.01)))
+12 IF 'FILEFLG
Begin DoDot:3
+13 SET ABORT=1
SET XPDABORT=2
+14 DO BMES^XPDUTL("Install process could not add an entry in file for "_$GET(IVMDATA(.01)))
+15 DO BMES^XPDUTL(" <<<< INSTALLATION ABORTED >>>>")
End DoDot:3
End DoDot:2
End DoDot:1
+16 IF 'ABORT
DO BMES^XPDUTL("<<<< Post Install Successful >>>>")
+17 QUIT
+18 ;
ADD(FILE,DATA) ;
+1 ;Description: Creates a new record and files the data.
+2 ; Input:
+3 ; FILE - File or sub-file number
+4 ; DATA - Data array to file, pass by reference
+5 ; Format: DATA(<field #>)=<value>
+6 ;
+7 ; Output:
+8 ; Function Value - If no error then it returns the ien of the created record, else returns NULL.
+9 ;
+10 NEW FDA,FIELD,IEN,IENA,IENS,IVMDA,ERRORS
+11 ;
+12 ;IENS - Internal Entry Number String defined by FM
+13 ;IENA - the Internal Entry Number Array defined by FM
+14 ;FDA - the FDA array defined by FM
+15 ;IEN - the ien of the new record
+16 ;
+17 SET IVMDA="+1"
+18 SET IENS=$$IENS^DILF(.IVMDA)
+19 SET FIELD=0
+20 FOR
SET FIELD=$ORDER(DATA(FIELD))
if 'FIELD
QUIT
Begin DoDot:1
+21 SET FDA(FILE,IENS,FIELD)=$GET(DATA(FIELD))
End DoDot:1
+22 IF $GET(IEN)
SET IENA(1)=IEN
+23 DO UPDATE^DIE("","FDA","IENA","ERRORS(1)")
+24 IF +$GET(DIERR)
Begin DoDot:1
+25 SET ERROR=$GET(ERRORS(1,"DIERR",1,"TEXT",1))
+26 SET IEN=""
End DoDot:1
+27 IF '$TEST
Begin DoDot:1
+28 SET IEN=IENA(1)
+29 SET ERROR=""
End DoDot:1
+30 DO CLEAN^DILF
+31 QUIT IEN
+32 ;
TEXT ;;FIELD#~VALUE;FIELD#~VALUE;FIELD#~VALUE.....
+1 ;;.01~RESIDENCE NUMBER CHANGE DT/TM;.02~RF171P;.03~1;.04~2;.05~.1321;.06~1;.07~1;.08~1;10~S DR=.1321 D LOOK^IVMPREC9;20~S DR=.1321 D LOOK^IVMPREC9
+2 ;;.01~RESIDENCE NUMBER CHANGE SOURCE;.02~RF162P;.03~1;.04~2;.05~.1322;.06~1;.07~1;.08~1;10~S DR=.1322 D LOOK^IVMPREC9;20~S DR=.1322 D LOOK^IVMPREC9
+3 ;;.01~RESIDENCE NUMBER CHANGE SITE;.02~RF161P;.03~1;.04~2;.05~.1323;.06~1;.07~1;.08~1;10~S DR=.1323 D LOOK^IVMPREC9;20~S DR=.1323 D LOOK^IVMPREC9
+4 ;;QUIT
