IVM2A102.m

IVM2A102 ;ALB/PJR - IVM*2.0*102 PRE-INSTALL ; 10/25/04 12:33pm

 ;;2.0;INCOME VERIFICATION MATCH;**102**; 21-OCT-94

 ;

 Q

PRE ; pre-install entry point

 ; add 2 new entries to the 301.92 file

 N FDA,DATA,ERR,XME,FLDNUM

 S DATA=""

 S XME="  >> Adding entries to IVM DEMOGRAPHIC UPLOAD FIELDS (#301.92) file"

 D BMES^XPDUTL(XME)

 D SOURCE(.DATA),UPDATE(.DATA)

 D LAST(.DATA),UPDATE(.DATA)

 ;;

 D MES^XPDUTL("")

 Q

 ;

SOURCE(DATA) ; setup fda array for Source of Notification for DOD

 S DATA(.01)="SOURCE OF NOTIFICATION"

 S DATA(.02)="ZPD31",DATA(.05)=.353,DATA(.04)=2

 S (DATA(.03),DATA(.06),DATA(.07))=1,DATA(.08)=0

 S (DATA(10),DATA(20))="S DR=.353 D LOOK^IVMPREC9"

 Q

 ;

LAST(DATA) ; setup fda array for Last Updated Date for DOD

 S DATA(.01)="DATE OF DEATH LAST UPDATED"

 S DATA(.02)="ZPD32",DATA(.05)=.354,DATA(.04)=2

 S (DATA(.03),DATA(.06),DATA(.07))=1,DATA(.08)=0

 S (DATA(10),DATA(20))="S DR=.354 D LOOK^IVMPREC9"

 Q

 ;

UPDATE(DATA) ;

 I $$FIND1^DIC(301.92,"","X",$G(DATA(.01))) D ALREADY Q

 S FLDNUM="" F  S FLDNUM=$O(DATA(FLDNUM)) Q:'FLDNUM  D ADD

 D UPDATE^DIE("","FDA","","ERR")

 I $D(ERR) D ERROR Q

 D SUCCESS

 K DATA

 Q

ADD ;;

 S FDA(301.92,"+1,",FLDNUM)=$G(DATA(FLDNUM)) Q

 ;

ALREADY ;;

 D BMES^XPDUTL("      *** "_$G(DATA(.01))_" entry already exists!") Q

ERROR ;

 D BMES^XPDUTL("   >>> ERROR! "_$G(DATA(.01))_" not added to file #301.92!")

 I $D(ERR("DIERR",1))=11 D

 .D MES^XPDUTL(ERR("DIERR",1)_": "_ERR("DIERR",1,"TEXT",1))

 Q

SUCCESS ;

 D BMES^XPDUTL("      "_$G(DATA(.01))_" successfully added.") Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IVM2A102   1570     printed  Apr 09, 2024@21:02:42                                                                                                                                                                                                    Page 2

IVM2A102  ;ALB/PJR - IVM*2.0*102 PRE-INSTALL ; 10/25/04 12:33pm

 +1       ;;2.0;INCOME VERIFICATION MATCH;**102**; 21-OCT-94

 +2       ;

 +3        QUIT 

PRE       ; pre-install entry point

 +1       ; add 2 new entries to the 301.92 file

 +2        NEW FDA,DATA,ERR,XME,FLDNUM

 +3        SET DATA=""

 +4        SET XME="  >> Adding entries to IVM DEMOGRAPHIC UPLOAD FIELDS (#301.92) file"

 +5        DO BMES^XPDUTL(XME)

 +6        DO SOURCE(.DATA)

           DO UPDATE(.DATA)

 +7        DO LAST(.DATA)

           DO UPDATE(.DATA)

 +8       ;;

 +9        DO MES^XPDUTL("")

 +10       QUIT 

 +11      ;

SOURCE(DATA) ; setup fda array for Source of Notification for DOD

 +1        SET DATA(.01)="SOURCE OF NOTIFICATION"

 +2        SET DATA(.02)="ZPD31"

           SET DATA(.05)=.353

           SET DATA(.04)=2

 +3        SET (DATA(.03),DATA(.06),DATA(.07))=1

           SET DATA(.08)=0

 +4        SET (DATA(10),DATA(20))="S DR=.353 D LOOK^IVMPREC9"

 +5        QUIT 

 +6       ;

LAST(DATA) ; setup fda array for Last Updated Date for DOD

 +1        SET DATA(.01)="DATE OF DEATH LAST UPDATED"

 +2        SET DATA(.02)="ZPD32"

           SET DATA(.05)=.354

           SET DATA(.04)=2

 +3        SET (DATA(.03),DATA(.06),DATA(.07))=1

           SET DATA(.08)=0

 +4        SET (DATA(10),DATA(20))="S DR=.354 D LOOK^IVMPREC9"

 +5        QUIT 

 +6       ;

UPDATE(DATA) ;

 +1        IF $$FIND1^DIC(301.92,"","X",$GET(DATA(.01)))

               DO ALREADY

               QUIT 

 +2        SET FLDNUM=""

           FOR 

               SET FLDNUM=$ORDER(DATA(FLDNUM))

               if 'FLDNUM

                   QUIT 

               DO ADD

 +3        DO UPDATE^DIE("","FDA","","ERR")

 +4        IF $DATA(ERR)

               DO ERROR

               QUIT 

 +5        DO SUCCESS

 +6        KILL DATA

 +7        QUIT 

ADD       ;;

 +1        SET FDA(301.92,"+1,",FLDNUM)=$GET(DATA(FLDNUM))

           QUIT 

 +2       ;

ALREADY   ;;

 +1        DO BMES^XPDUTL("      *** "_$GET(DATA(.01))_" entry already exists!")

           QUIT 

ERROR     ;

 +1        DO BMES^XPDUTL("   >>> ERROR! "_$GET(DATA(.01))_" not added to file #301.92!")

 +2        IF $DATA(ERR("DIERR",1))=11

               Begin DoDot:1

 +3                DO MES^XPDUTL(ERR("DIERR",1)_": "_ERR("DIERR",1,"TEXT",1))

               End DoDot:1

 +4        QUIT 

SUCCESS   ;

 +1        DO BMES^XPDUTL("      "_$GET(DATA(.01))_" successfully added.")

           QUIT