IVM279P ;ALB/BRM - IVM*2*79 PRE-INSTALL ; 7/30/03 10:17am
;;2.0;INCOME VERIFICATION MATCH;**79**; 21-OCT-94
;
Q
PRE ; pre-install entry point
; add 3 new entries to the 301.92 file
N FDA,DATA,ERR
S DATA=""
D BMES^XPDUTL(" >> Adding entries to IVM DEMOGRAPHIC UPLOAD FIELDS (#301.92) file")
D ADDRDT(.DATA),UPDATE(.DATA)
D ADDRSRC(.DATA),UPDATE(.DATA)
D ADDRSIT(.DATA),UPDATE(.DATA)
D MES^XPDUTL("")
Q
;
ADDRDT(DATA) ; setup fda array for Address Change Dt/Tm entry
S DATA(.01)="ADDRESS CHANGE DT/TM"
S DATA(.02)="RF171",DATA(.05)=.118,DATA(.04)=2
S (DATA(.03),DATA(.06),DATA(.07),DATA(.08))=1
S (DATA(10),DATA(20))="S DR=.118 D LOOK^IVMPREC9"
Q
;
ADDRSRC(DATA) ; setup fda array for Address Change Source entry
S DATA(.01)="ADDRESS CHANGE SOURCE"
S DATA(.02)="RF162",DATA(.05)=.119,DATA(.04)=2
S (DATA(.03),DATA(.06),DATA(.07),DATA(.08))=1
S (DATA(10),DATA(20))="S DR=.119 D LOOK^IVMPREC9"
Q
;
ADDRSIT(DATA) ; setup fda array for Address Change Dt/Tm entry
S DATA(.01)="ADDRESS CHANGE SITE"
S DATA(.02)="RF161",DATA(.05)=.12,DATA(.04)=2
S (DATA(.03),DATA(.06),DATA(.07),DATA(.08))=1
S (DATA(10),DATA(20))="S DR=.12 D LOOK^IVMPREC9"
Q
;
UPDATE(DATA) ;
I $$FIND1^DIC(301.92,"","X",$G(DATA(.01))) D BMES^XPDUTL(" *** "_$G(DATA(.01))_" entry already exists!") Q
S FLDNUM="" F S FLDNUM=$O(DATA(FLDNUM)) Q:'FLDNUM S FDA(301.92,"+1,",FLDNUM)=$G(DATA(FLDNUM))
D UPDATE^DIE("","FDA","","ERR")
I $D(ERR) D BMES^XPDUTL(" >>> ERROR! "_$G(DATA(.01))_" not added to file #301.92!"),MES^XPDUTL(ERR("DIERR",1)_": "_ERR("DIERR",1,"TEXT",1)) Q
D BMES^XPDUTL(" "_$G(DATA(.01))_" successfully added.")
K DATA
Q
;
POST ; post-install process to task one-time clean-up
;
N IVMTSK,IVMDT
D BMES^XPDUTL(" >> Tasking IVM Clean-up job to run in 30 days")
D BMES^XPDUTL(" WARNING: This clean-up will delete DEMOGRAPHIC UPLOAD DATA")
D MES^XPDUTL(" from the IVM PATIENT (#301.5) file when it runs.")
D BMES^XPDUTL(" Please notify the appropriate personnel to take action on any")
D MES^XPDUTL(" outstanding demographics uploaded data from HEC, if your site")
D MES^XPDUTL(" processes IVM DEMOGRAPHICS UPLOADs on a regular basis.")
D DT^DILF("X","T+30",.IVMDT) S:IVMDT IVMDT=IVMDT_.180000
S IVMTSK=$$QUETSK($G(IVMDT))
I 'IVMTSK D BMES^XPDUTL(" ***ERROR: IVM DEMOGRAPHICS CLEAN-UP could not be tasked."),BMES^XPDUTL(" >>> Please contact NVS for assistance <<<") Q
D BMES^XPDUTL(" Task #"_IVMTSK_" has been queued to run on "_$$FMTE^XLFDT(IVMDT)_".")
D MES^XPDUTL(" This task can be rescheduled for an earlier date if desired.")
Q
QUETSK(ZTDTH) ;
N ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,ZUSR,POP,X,ERR
Q:'$G(ZTDTH) 0
S ZTRTN="EN^IVMLDEMC()",ZTDESC="IVM DEMOGRAPHICS CLEAN-UP",ZTIO=""
D ^%ZTLOAD
Q +$G(ZTSK)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVM279P 2827 printed Nov 22, 2024@17:11:08 Page 2
IVM279P ;ALB/BRM - IVM*2*79 PRE-INSTALL ; 7/30/03 10:17am
+1 ;;2.0;INCOME VERIFICATION MATCH;**79**; 21-OCT-94
+2 ;
+3 QUIT
PRE ; pre-install entry point
+1 ; add 3 new entries to the 301.92 file
+2 NEW FDA,DATA,ERR
+3 SET DATA=""
+4 DO BMES^XPDUTL(" >> Adding entries to IVM DEMOGRAPHIC UPLOAD FIELDS (#301.92) file")
+5 DO ADDRDT(.DATA)
DO UPDATE(.DATA)
+6 DO ADDRSRC(.DATA)
DO UPDATE(.DATA)
+7 DO ADDRSIT(.DATA)
DO UPDATE(.DATA)
+8 DO MES^XPDUTL("")
+9 QUIT
+10 ;
ADDRDT(DATA) ; setup fda array for Address Change Dt/Tm entry
+1 SET DATA(.01)="ADDRESS CHANGE DT/TM"
+2 SET DATA(.02)="RF171"
SET DATA(.05)=.118
SET DATA(.04)=2
+3 SET (DATA(.03),DATA(.06),DATA(.07),DATA(.08))=1
+4 SET (DATA(10),DATA(20))="S DR=.118 D LOOK^IVMPREC9"
+5 QUIT
+6 ;
ADDRSRC(DATA) ; setup fda array for Address Change Source entry
+1 SET DATA(.01)="ADDRESS CHANGE SOURCE"
+2 SET DATA(.02)="RF162"
SET DATA(.05)=.119
SET DATA(.04)=2
+3 SET (DATA(.03),DATA(.06),DATA(.07),DATA(.08))=1
+4 SET (DATA(10),DATA(20))="S DR=.119 D LOOK^IVMPREC9"
+5 QUIT
+6 ;
ADDRSIT(DATA) ; setup fda array for Address Change Dt/Tm entry
+1 SET DATA(.01)="ADDRESS CHANGE SITE"
+2 SET DATA(.02)="RF161"
SET DATA(.05)=.12
SET DATA(.04)=2
+3 SET (DATA(.03),DATA(.06),DATA(.07),DATA(.08))=1
+4 SET (DATA(10),DATA(20))="S DR=.12 D LOOK^IVMPREC9"
+5 QUIT
+6 ;
UPDATE(DATA) ;
+1 IF $$FIND1^DIC(301.92,"","X",$GET(DATA(.01)))
DO BMES^XPDUTL(" *** "_$GET(DATA(.01))_" entry already exists!")
QUIT
+2 SET FLDNUM=""
FOR
SET FLDNUM=$ORDER(DATA(FLDNUM))
if 'FLDNUM
QUIT
SET FDA(301.92,"+1,",FLDNUM)=$GET(DATA(FLDNUM))
+3 DO UPDATE^DIE("","FDA","","ERR")
+4 IF $DATA(ERR)
DO BMES^XPDUTL(" >>> ERROR! "_$GET(DATA(.01))_" not added to file #301.92!")
DO MES^XPDUTL(ERR("DIERR",1)_": "_ERR("DIERR",1,"TEXT",1))
QUIT
+5 DO BMES^XPDUTL(" "_$GET(DATA(.01))_" successfully added.")
+6 KILL DATA
+7 QUIT
+8 ;
POST ; post-install process to task one-time clean-up
+1 ;
+2 NEW IVMTSK,IVMDT
+3 DO BMES^XPDUTL(" >> Tasking IVM Clean-up job to run in 30 days")
+4 DO BMES^XPDUTL(" WARNING: This clean-up will delete DEMOGRAPHIC UPLOAD DATA")
+5 DO MES^XPDUTL(" from the IVM PATIENT (#301.5) file when it runs.")
+6 DO BMES^XPDUTL(" Please notify the appropriate personnel to take action on any")
+7 DO MES^XPDUTL(" outstanding demographics uploaded data from HEC, if your site")
+8 DO MES^XPDUTL(" processes IVM DEMOGRAPHICS UPLOADs on a regular basis.")
+9 DO DT^DILF("X","T+30",.IVMDT)
if IVMDT
SET IVMDT=IVMDT_.180000
+10 SET IVMTSK=$$QUETSK($GET(IVMDT))
+11 IF 'IVMTSK
DO BMES^XPDUTL(" ***ERROR: IVM DEMOGRAPHICS CLEAN-UP could not be tasked.")
DO BMES^XPDUTL(" >>> Please contact NVS for assistance <<<")
QUIT
+12 DO BMES^XPDUTL(" Task #"_IVMTSK_" has been queued to run on "_$$FMTE^XLFDT(IVMDT)_".")
+13 DO MES^XPDUTL(" This task can be rescheduled for an earlier date if desired.")
+14 QUIT
QUETSK(ZTDTH) ;
+1 NEW ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,ZUSR,POP,X,ERR
+2 if '$GET(ZTDTH)
QUIT 0
+3 SET ZTRTN="EN^IVMLDEMC()"
SET ZTDESC="IVM DEMOGRAPHICS CLEAN-UP"
SET ZTIO=""
+4 DO ^%ZTLOAD
+5 QUIT +$GET(ZTSK)
