- 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 ---[H[J[2J[HIVM2A102 1570 printed Feb 18, 2025@23:26:40 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