DG272PT2 ;ALB/SEK DG*5.3*272 POST-INSTALL TO CLOSE IVM CASES ; 02/03/00
;;5.3;Registration;**272,1015**;Aug 13, 1993;Build 21
;
;This routine will be run as part of the post-install for patch
;DG*5.3*272
;
;This routine will use the "AYR" cross-reference to loop through the
;IVM PATIENT file (#301.5) for income years 1992-1996 to find and
;close all open cases.
;
;The following fields in the IVM PATIENT file will be updated:
;.03 - TRANSMISSION STATUS - 1 for transmitted
;.04 - STOP FLAG - 1 for stop
;1.01 - CLOSURE REASON - 5 for "OLD CASE NO ACTION"
;1.02 - CLOSURE SOURCE - 2 for DHCP
;1.03 - CLOSURE DATE/TIME - current date/time
;
;A mail message will be sent to the HEC and the user
;when the post-install is complete.
;
POST ;entry point for post-install, setting up checkpoints
N %
S %=$$NEWCP^XPDUTL("DGDATE","",2910000)
S %=$$NEWCP^XPDUTL("DGDFN","",0)
Q
;
EN ; begin processing
;
;go through IVM PATIENT file (#301.5) finding patients
;with open cases for income years 1992-1996.
;
N DATA,DGDATE,DGDFN
;
;get value from checkpoints, previous run
I $D(XPDNM) S DGDATE=+$$PARCP^XPDUTL("DGDATE")
I $G(DGDATE)="" S DGDATE=2910000
I $D(XPDNM) S DGDFN=+$$PARCP^XPDUTL("DGDFN")
I $G(DGDFN)="" S DGDFN=0
;
D BMES^XPDUTL("Beginning case closing process "_$$FMTE^XLFDT($$NOW^XLFDT))
D SETUP
D SEARCH
D MAIL
I $D(XPDNM) S %=$$COMCP^XPDUTL("DGDATE")
D MES^XPDUTL(" >>closing process completed "_$$FMTE^XLFDT($$NOW^XLFDT))
Q
;
;
SETUP ;setup data array for closing cases
N %
S DATA(.03)=1
S DATA(.04)=1
S DATA(1.01)=5
S DATA(1.02)=2
D NOW^%DTC S DATA(1.03)=%
Q
;
SEARCH ; Search for open cases
N %,DGIEN,ERROR
F S DGDATE=$O(^IVM(301.5,"AYR",DGDATE)) Q:('DGDATE!(DGDATE>2960000)) D
.S:'$D(DGDFN) DGDFN=0
.F S DGDFN=$O(^IVM(301.5,"AYR",DGDATE,DGDFN)) D Q:'DGDFN
..I 'DGDFN D Q
...I $D(XPDNM) S %=$$UPCP^XPDUTL("DGDATE",DGDATE)
..;
..S DGIEN=$O(^IVM(301.5,"AYR",DGDATE,DGDFN,0)) Q:'DGIEN
..;
..; - quit if case closed
..Q:+$G(^IVM(301.5,DGIEN,1))
..;
..;close case
..I '$$UPD^DGENDBS(301.5,DGIEN,.DATA,.ERROR) D G UPCP
...D ERRS^DG272PT1(301.5,DGIEN,.ERROR)
...Q
..;add to counter - number of cases closed by income year
..S $P(^XTMP("DGMTPCT",$E(DGDATE,1,3)),"^",2)=$P($G(^XTMP("DGMTPCT",$E(DGDATE,1,3))),"^",2)+1
..;
UPCP ..I $D(XPDNM) S %=$$UPCP^XPDUTL("DGDFN",DGDFN)
..Q
.Q
SEARCHQ Q
;
;
MAIL ; Send a mailman msg to user/HEC with results
N DIFROM,%
N IVMCX,IVMDATA,IVMDATA1,IVMDATA2,IVMFILE,IVMFLD,IVMIENX,IVMIY,IVMNODE,IVMTEXT,IVMX
N X,XMDUZ,XMSUB,XMTEXT,XMY,Y
K ^TMP("DG272PT",$J)
S XMSUB="Purge of IVM verified Means Tests and closing of IVM CASES"
S XMDUZ="IVM/HEC PACKAGE",XMY("HARBIN,LYNNE@IVM.VA.GOV")="",XMY(DUZ)="",XMY(.5)="",XMY("PERREAULT,JEAN@IVM.VA.GOV")=""
S XMY("PICKELSIMER,HENRY@IVM.VA.GOV")="",XMY("STEFFEY,KIM@IVM.VA.GOV")=""
S XMY("ARMOUR,EDDIE@IVM.VA.GOV")="",XMY("WHITFIELD,VENIS@IVM.VA.GOV")=""
S XMTEXT="^TMP(""DG272PT"",$J,"
S IVMCX=$$SITE^VASITE
D NOW^%DTC S Y=% D DD^%DT
S ^TMP("DG272PT",$J,1)="Purge of IVM verified Means Tests and closing of IVM CASES"
S ^TMP("DG272PT",$J,2)=" "
S ^TMP("DG272PT",$J,3)="Facility Name: "_$P(IVMCX,"^",2)_" "_Y
S ^TMP("DG272PT",$J,4)="Station Number: "_$P(IVMCX,"^",3)
S ^TMP("DG272PT",$J,5)=" "
S IVMTEXT="Income year"
S IVMTEXT=$$BLDSTR^DG272PT1("# of IVM MT purged",IVMTEXT,20,18)
S IVMTEXT=$$BLDSTR^DG272PT1("# of cases closed",IVMTEXT,40,17)
S ^TMP("DG272PT",$J,6)=IVMTEXT
S IVMTEXT=$$REPEAT^XLFSTR("=",$L(IVMTEXT))
S ^TMP("DG272PT",$J,7)=IVMTEXT
S IVMIY=0,IVMNODE=7
F S IVMIY=$O(^XTMP("DGMTPCT",IVMIY)) Q:'IVMIY D
.S IVMDATA=^XTMP("DGMTPCT",IVMIY)
.S IVMTEXT=IVMIY+1700
.S IVMDATA1=$J(+$P(IVMDATA,U),6)
.S IVMDATA2=$J(+$P(IVMDATA,U,2),6)
.S IVMTEXT=$$BLDSTR^DG272PT1(IVMDATA1,IVMTEXT,20,$L(IVMDATA1))
.S IVMTEXT=$$BLDSTR^DG272PT1(IVMDATA2,IVMTEXT,40,$L(IVMDATA2))
.S IVMNODE=IVMNODE+1
.S ^TMP("DG272PT",$J,IVMNODE)=IVMTEXT
F I=1:1:2 S IVMNODE=IVMNODE+1,^TMP("DG272PT",$J,IVMNODE)=" "
;
; add error reports to the mail message...
I $O(^XTMP("DGMTPERR",0))'="" D
.S IVMNODE=IVMNODE+1
.S ^TMP("DG272PT",$J,IVMNODE)="Some records were not edited due to filing errors:"
.S IVMNODE=IVMNODE+1
.S ^TMP("DG272PT",$J,IVMNODE)=" "
.S IVMTEXT="File #"
.S IVMTEXT=$$BLDSTR^DG272PT1("Record #",IVMTEXT,12,8)
.S IVMTEXT=$$BLDSTR^DG272PT1("Field #",IVMTEXT,22,7)
.S IVMTEXT=$$BLDSTR^DG272PT1("Error Message",IVMTEXT,30,13)
.S IVMNODE=IVMNODE+1
.S ^TMP("DG272PT",$J,IVMNODE)=IVMTEXT
.K IVMTEXT
.S IVMFILE=0
.F S IVMFILE=$O(^XTMP("DGMTPERR",IVMFILE)) Q:'IVMFILE D
..S IVMTEXT=IVMFILE
..S IVMIENX=0
..F S IVMIENX=$O(^XTMP("DGMTPERR",IVMFILE,IVMIENX)) Q:'IVMIENX D
...S IVMFLD=0
...F S IVMFLD=$O(^XTMP("DGMTPERR",IVMFILE,IVMIENX,IVMFLD)) Q:'IVMFLD D
....S IVMX=0
....F S IVMX=$O(^XTMP("DGMTPERR",IVMFILE,IVMIENX,IVMFLD,IVMX)) Q:'IVMX D
.....S IVMDATA=^XTMP("DGMTPERR",IVMFILE,IVMIENX,IVMFLD,IVMX)
.....S IVMTEXT=$$BLDSTR^DG272PT1(IVMIENX,IVMTEXT,12,$L(IVMIENX))
.....S IVMTEXT=$$BLDSTR^DG272PT1(IVMFLD,IVMTEXT,22,$L(IVMFLD))
.....S IVMTEXT=$$BLDSTR^DG272PT1(IVMDATA,IVMTEXT,30,$L(IVMDATA))
.....S IVMNODE=IVMNODE+1
.....S ^TMP("DG272PT",$J,IVMNODE)=IVMTEXT
.....K IVMDATA
....K IVMX
...K IVMFLD
..K IVMIENX
.K IVMFILE,IVMTEXT
;
MAIL1 D ^XMD
K ^TMP("DG272PT",$J)
Q
DG272PT2 ;ALB/SEK DG*5.3*272 POST-INSTALL TO CLOSE IVM CASES ; 02/03/00
+1 ;;5.3;Registration;**272,1015**;Aug 13, 1993;Build 21
+2 ;
+3 ;This routine will be run as part of the post-install for patch
+4 ;DG*5.3*272
+5 ;
+6 ;This routine will use the "AYR" cross-reference to loop through the
+7 ;IVM PATIENT file (#301.5) for income years 1992-1996 to find and
+8 ;close all open cases.
+9 ;
+10 ;The following fields in the IVM PATIENT file will be updated:
+11 ;.03 - TRANSMISSION STATUS - 1 for transmitted
+12 ;.04 - STOP FLAG - 1 for stop
+13 ;1.01 - CLOSURE REASON - 5 for "OLD CASE NO ACTION"
+14 ;1.02 - CLOSURE SOURCE - 2 for DHCP
+15 ;1.03 - CLOSURE DATE/TIME - current date/time
+16 ;
+17 ;A mail message will be sent to the HEC and the user
+18 ;when the post-install is complete.
+19 ;
POST ;entry point for post-install, setting up checkpoints
+1 NEW %
+2 SET %=$$NEWCP^XPDUTL("DGDATE","",2910000)
+3 SET %=$$NEWCP^XPDUTL("DGDFN","",0)
+4 QUIT
+5 ;
EN ; begin processing
+1 ;
+2 ;go through IVM PATIENT file (#301.5) finding patients
+3 ;with open cases for income years 1992-1996.
+4 ;
+5 NEW DATA,DGDATE,DGDFN
+6 ;
+7 ;get value from checkpoints, previous run
+8 IF $DATA(XPDNM)
SET DGDATE=+$$PARCP^XPDUTL("DGDATE")
+9 IF $GET(DGDATE)=""
SET DGDATE=2910000
+10 IF $DATA(XPDNM)
SET DGDFN=+$$PARCP^XPDUTL("DGDFN")
+11 IF $GET(DGDFN)=""
SET DGDFN=0
+12 ;
+13 DO BMES^XPDUTL("Beginning case closing process "_$$FMTE^XLFDT($$NOW^XLFDT))
+14 DO SETUP
+15 DO SEARCH
+16 DO MAIL
+17 IF $DATA(XPDNM)
SET %=$$COMCP^XPDUTL("DGDATE")
+18 DO MES^XPDUTL(" >>closing process completed "_$$FMTE^XLFDT($$NOW^XLFDT))
+19 QUIT
+20 ;
+21 ;
SETUP ;setup data array for closing cases
+1 NEW %
+2 SET DATA(.03)=1
+3 SET DATA(.04)=1
+4 SET DATA(1.01)=5
+5 SET DATA(1.02)=2
+6 DO NOW^%DTC
SET DATA(1.03)=%
+7 QUIT
+8 ;
SEARCH ; Search for open cases
+1 NEW %,DGIEN,ERROR
+2 FOR
SET DGDATE=$ORDER(^IVM(301.5,"AYR",DGDATE))
IF ('DGDATE!(DGDATE>2960000))
QUIT
Begin DoDot:1
+3 IF '$DATA(DGDFN)
SET DGDFN=0
+4 FOR
SET DGDFN=$ORDER(^IVM(301.5,"AYR",DGDATE,DGDFN))
Begin DoDot:2
+5 IF 'DGDFN
Begin DoDot:3
+6 IF $DATA(XPDNM)
SET %=$$UPCP^XPDUTL("DGDATE",DGDATE)
End DoDot:3
QUIT
+7 ;
+8 SET DGIEN=$ORDER(^IVM(301.5,"AYR",DGDATE,DGDFN,0))
IF 'DGIEN
QUIT
+9 ;
+10 ; - quit if case closed
+11 IF +$GET(^IVM(301.5,DGIEN,1))
QUIT
+12 ;
+13 ;close case
+14 IF '$$UPD^DGENDBS(301.5,DGIEN,.DATA,.ERROR)
Begin DoDot:3
+15 DO ERRS^DG272PT1(301.5,DGIEN,.ERROR)
+16 QUIT
End DoDot:3
GOTO UPCP
+17 ;add to counter - number of cases closed by income year
+18 SET $PIECE(^XTMP("DGMTPCT",$EXTRACT(DGDATE,1,3)),"^",2)=$PIECE($GET(^XTMP("DGMTPCT",$EXTRACT(DGDATE,1,3))),"^",2)+1
+19 ;
UPCP IF $DATA(XPDNM)
SET %=$$UPCP^XPDUTL("DGDFN",DGDFN)
+1 QUIT
End DoDot:2
IF 'DGDFN
QUIT
+2 QUIT
End DoDot:1
SEARCHQ QUIT
+1 ;
+2 ;
MAIL ; Send a mailman msg to user/HEC with results
+1 NEW DIFROM,%
+2 NEW IVMCX,IVMDATA,IVMDATA1,IVMDATA2,IVMFILE,IVMFLD,IVMIENX,IVMIY,IVMNODE,IVMTEXT,IVMX
+3 NEW X,XMDUZ,XMSUB,XMTEXT,XMY,Y
+4 KILL ^TMP("DG272PT",$JOB)
+5 SET XMSUB="Purge of IVM verified Means Tests and closing of IVM CASES"
+6 SET XMDUZ="IVM/HEC PACKAGE"
SET XMY("HARBIN,LYNNE@IVM.VA.GOV")=""
SET XMY(DUZ)=""
SET XMY(.5)=""
SET XMY("PERREAULT,JEAN@IVM.VA.GOV")=""
+7 SET XMY("PICKELSIMER,HENRY@IVM.VA.GOV")=""
SET XMY("STEFFEY,KIM@IVM.VA.GOV")=""
+8 SET XMY("ARMOUR,EDDIE@IVM.VA.GOV")=""
SET XMY("WHITFIELD,VENIS@IVM.VA.GOV")=""
+9 SET XMTEXT="^TMP(""DG272PT"",$J,"
+10 SET IVMCX=$$SITE^VASITE
+11 DO NOW^%DTC
SET Y=%
DO DD^%DT
+12 SET ^TMP("DG272PT",$JOB,1)="Purge of IVM verified Means Tests and closing of IVM CASES"
+13 SET ^TMP("DG272PT",$JOB,2)=" "
+14 SET ^TMP("DG272PT",$JOB,3)="Facility Name: "_$PIECE(IVMCX,"^",2)_" "_Y
+15 SET ^TMP("DG272PT",$JOB,4)="Station Number: "_$PIECE(IVMCX,"^",3)
+16 SET ^TMP("DG272PT",$JOB,5)=" "
+17 SET IVMTEXT="Income year"
+18 SET IVMTEXT=$$BLDSTR^DG272PT1("# of IVM MT purged",IVMTEXT,20,18)
+19 SET IVMTEXT=$$BLDSTR^DG272PT1("# of cases closed",IVMTEXT,40,17)
+20 SET ^TMP("DG272PT",$JOB,6)=IVMTEXT
+21 SET IVMTEXT=$$REPEAT^XLFSTR("=",$LENGTH(IVMTEXT))
+22 SET ^TMP("DG272PT",$JOB,7)=IVMTEXT
+23 SET IVMIY=0
SET IVMNODE=7
+24 FOR
SET IVMIY=$ORDER(^XTMP("DGMTPCT",IVMIY))
IF 'IVMIY
QUIT
Begin DoDot:1
+25 SET IVMDATA=^XTMP("DGMTPCT",IVMIY)
+26 SET IVMTEXT=IVMIY+1700
+27 SET IVMDATA1=$JUSTIFY(+$PIECE(IVMDATA,U),6)
+28 SET IVMDATA2=$JUSTIFY(+$PIECE(IVMDATA,U,2),6)
+29 SET IVMTEXT=$$BLDSTR^DG272PT1(IVMDATA1,IVMTEXT,20,$LENGTH(IVMDATA1))
+30 SET IVMTEXT=$$BLDSTR^DG272PT1(IVMDATA2,IVMTEXT,40,$LENGTH(IVMDATA2))
+31 SET IVMNODE=IVMNODE+1
+32 SET ^TMP("DG272PT",$JOB,IVMNODE)=IVMTEXT
End DoDot:1
+33 FOR I=1:1:2
SET IVMNODE=IVMNODE+1
SET ^TMP("DG272PT",$JOB,IVMNODE)=" "
+34 ;
+35 ; add error reports to the mail message...
+36 IF $ORDER(^XTMP("DGMTPERR",0))'=""
Begin DoDot:1
+37 SET IVMNODE=IVMNODE+1
+38 SET ^TMP("DG272PT",$JOB,IVMNODE)="Some records were not edited due to filing errors:"
+39 SET IVMNODE=IVMNODE+1
+40 SET ^TMP("DG272PT",$JOB,IVMNODE)=" "
+41 SET IVMTEXT="File #"
+42 SET IVMTEXT=$$BLDSTR^DG272PT1("Record #",IVMTEXT,12,8)
+43 SET IVMTEXT=$$BLDSTR^DG272PT1("Field #",IVMTEXT,22,7)
+44 SET IVMTEXT=$$BLDSTR^DG272PT1("Error Message",IVMTEXT,30,13)
+45 SET IVMNODE=IVMNODE+1
+46 SET ^TMP("DG272PT",$JOB,IVMNODE)=IVMTEXT
+47 KILL IVMTEXT
+48 SET IVMFILE=0
+49 FOR
SET IVMFILE=$ORDER(^XTMP("DGMTPERR",IVMFILE))
IF 'IVMFILE
QUIT
Begin DoDot:2
+50 SET IVMTEXT=IVMFILE
+51 SET IVMIENX=0
+52 FOR
SET IVMIENX=$ORDER(^XTMP("DGMTPERR",IVMFILE,IVMIENX))
IF 'IVMIENX
QUIT
Begin DoDot:3
+53 SET IVMFLD=0
+54 FOR
SET IVMFLD=$ORDER(^XTMP("DGMTPERR",IVMFILE,IVMIENX,IVMFLD))
IF 'IVMFLD
QUIT
Begin DoDot:4
+55 SET IVMX=0
+56 FOR
SET IVMX=$ORDER(^XTMP("DGMTPERR",IVMFILE,IVMIENX,IVMFLD,IVMX))
IF 'IVMX
QUIT
Begin DoDot:5
+57 SET IVMDATA=^XTMP("DGMTPERR",IVMFILE,IVMIENX,IVMFLD,IVMX)
+58 SET IVMTEXT=$$BLDSTR^DG272PT1(IVMIENX,IVMTEXT,12,$LENGTH(IVMIENX))
+59 SET IVMTEXT=$$BLDSTR^DG272PT1(IVMFLD,IVMTEXT,22,$LENGTH(IVMFLD))
+60 SET IVMTEXT=$$BLDSTR^DG272PT1(IVMDATA,IVMTEXT,30,$LENGTH(IVMDATA))
+61 SET IVMNODE=IVMNODE+1
+62 SET ^TMP("DG272PT",$JOB,IVMNODE)=IVMTEXT
+63 KILL IVMDATA
End DoDot:5
+64 KILL IVMX
End DoDot:4
+65 KILL IVMFLD
End DoDot:3
+66 KILL IVMIENX
End DoDot:2
+67 KILL IVMFILE,IVMTEXT
End DoDot:1
+68 ;
MAIL1 DO ^XMD
+1 KILL ^TMP("DG272PT",$JOB)
+2 QUIT
