IVM268PT ;ALB/SCK - IVM*2*68 POST-INSTALL TO CLOSE IVM CASES ; 10/18/02
;;2.0;INCOME VERIFICATION MATCH;**68**; 21-OCT-94
;
;This routine will be run as part of the post-install for patch
;IVM*2*68
;
;This routine will close all IVM open cases in the IVM PATIENT File,
;#301.5, for income years 1997 through the present. Patch
;DG*5.3*272 closed all IVM open cases up through 1996
;
; The following fields in the IVM PATIENT File, #301.5 will be updated:
; .03 - TRANSMISSION STATUS = 1
; .04 - STOP FLAG = 1
; 1.01 - CLOSURE REASON = 5 "OLD CASE NO ACTION"
; 1.02 - CLOSURE SOURCE = 2 "DHCP"
; 1.03 - CLOSURE DATE/TIME = Current D/T
;
;A mail message will be sent to the user when the post-install is complete.
;Additionally, details and any error messages will be stored in XTMP globals
;for review.
;
POST ; Initialize post install
N %,I,X,IVMGBL
;
; Check post-install closure question
I $D(XPDNM),$D(XPDQUES) Q:'+XPDQUES("POS001")
; Post-install checkpoints setup
I $D(XPDNM) D
. I $$VERCP^XPDUTL("IVMICY")'>0 D
. . S %=$$NEWCP^XPDUTL("IVMICY","","2960000")
. I $$VERCP^XPDUTL("IVMDFN")'>0 D
. . S %=$$NEWCP^XPDUTL("IVMDFN","",0)
;
QUE ;
N ZTRTN,ZTDESC,ZTSAVE,ZTDTH,ZTIO,ZTSK
;
S ZTRTN="EN^IVM268PT"
S ZTDESC="PATCH IVM*2*68 POST INSTALL"
S ZTSAVE("DUZ")=""
S ZTDTH=$$NOW^XLFDT
S ZTIO=""
;
D ^%ZTLOAD
I $D(ZTSK)[0 D BMES^XPDUTL("Post-Install was not tasked off")
E D BMES^XPDUTL("Post-Install tasked. ["_ZTSK_"]")
D HOME^%ZIS
Q
;
EN ;
; Initialize the XTMP tracking global
I '$D(^XTMP("IVMPCT68")) D
. S ^XTMP("IVMPCT68",0)=$$FMADD^XLFDT($$DT^XLFDT,30)_"^"_$$DT^XLFDT_"^IVM*2*68 POST INSTALL RECORD COUNT"
;
I '$D(^XTMP("IVMERR68")) D
. S ^XTMP("IVMERR68",0)=$$FMADD^XLFDT($$DT^XLFDT,30)_"^"_$$DT^XLFDT_"^IVM*2*68 POST INSTALL FILING ERRORS"
;
; Begin Processing
N DATA,IVMICY,IVMDFN
;
;Get values from checkpoints if there was a previous run
I $D(XPDNM) S IVMICY=$$PARCP^XPDUTL("IVMICY")
I $G(IVMICY)="" S IVMICY=2960000
;
I $D(XPDNM) S IVMDFN=$$PARCP^XPDUTL("IVMDFN")
I $G(IVMDFN)="" S IVMDFN=0
;
D BMES^XPDUTL("Beginning case closing process "_$$FMTE^XLFDT($$NOW^XLFDT))
D CLNUP(IVMICY,IVMDFN)
D MAIL
; Close checkpoint
I $D(XPDNM) D
. S %=$$COMCP^XPDUTL("IVMICY")
. S %=$$COMCP^XPDUTL("IVMDFN")
D BMES^XPDUTL("Completed case closing process "_$$FMTE^XLFDT($$NOW^XLFDT))
Q
;
CLNUP(IVMICY,IVMDFN) ; Search for open cases
N %,DATA,IVMIEN,IVMDT,IVMDFN1,NODE1,ERROR,IVMOK,IVMABRT
;
; Set data array for closing
S DATA(.03)=1
S DATA(.04)=1
S DATA(1.01)=5
S DATA(1.02)=2
S DATA(1.03)=$$NOW^XLFDT
;
S IVMDT=IVMICY,IVMOK=1
; First loop on Income Year
F S IVMDT=$O(^IVM(301.5,"AYR",IVMDT)) Q:'IVMDT D Q:$G(IVMABRT)
. I $$S^%ZTLOAD S IVMABRT=1 Q
. S IVMDFN1=IVMDFN
. ; Second loop on DFN
. F S IVMDFN1=$O(^IVM(301.5,"AYR",IVMDT,IVMDFN1)) D Q:'IVMDFN1
. . I 'IVMDFN1 D Q
. . . ; Update checkpoint on last DFN for Income Year
. . . I $D(XPDNM) S %=$$UPCP^XPDUTL("IVMICY",IVMDT)
. . S IVMIEN=$O(^IVM(301.5,"AYR",IVMDT,IVMDFN1,0))
. . Q:'$D(^IVM(301.5,IVMIEN)) ; Quit if not a valid record
. . S NODE1=$G(^IVM(301.5,IVMIEN,1))
. . Q:$P(NODE1,U,1)]"" ; Quit if case already closed
. . ; Close case
. . S IVMOK=$$UPD^DGENDBS(301.5,IVMIEN,.DATA,.ERROR)
. . I 'IVMOK S ^XTMP("IVMERR68",IVMIEN)=$G(ERROR)
. . ; Update Counter
. . S ^XTMP("IVMPCT68",IVMDT)=$G(^XTMP("IVMPCT68",IVMDT))+1
. . ; Update checkpoint for completed DFN
. . I $D(XPDNM) S %=$$UPCP^XPDUTL("IVMDFN",IVMDFN1)
Q
;
MAIL ; Send mail message with results
N X,XMDUZ,XMTEXT,XMSUB,XMY,Y,TEMP,LINE,IVMYR,SPACE
N %,DIFROM
;
S TEMP="^TMP(""IVM68"",$J)"
K @TEMP
S XMSUB="Post Install - Closing of IVM Cases"
S XMDUZ("PATCH IVM-2-68")=""
S XMY(.5)="",XMY(DUZ)=""
S XMTEXT="^TMP(""IVM68"",$J,"
;
S $P(SPACE," ",20)=""
S @TEMP@(1)="Closing of IVM Cases"
S @TEMP@(2)=" "
S @TEMP@(3)="Income year"_SPACE_"# of cases closed"
S @TEMP@(4)="==========="_SPACE_"================="
S LINE=10
S IVMYR=0
F S IVMYR=$O(^XTMP("IVMPCT68",IVMYR)) Q:'IVMYR D
. S @TEMP@(LINE)=$$FMTE^XLFDT(IVMYR)_SPACE_$J($FN($G(^XTMP("IVMPCT68",IVMYR)),","),20)
. S LINE=LINE+1
;
; Add Errors to mail message
S @TEMP@(LINE)="",LINE=LINE+1
S @TEMP@(LINE)="Some records may not have been edited due to filing errors.",LINE=LINE+1
S @TEMP@(LINE)="Those records are listed below:",LINE=LINE+1
S IVMIEN=0
F S IVMIEN=$O(^XTMP("IVMERR68",IVMIEN)) Q:'IVMIEN D
. S @TEMP@(LINE)="Record: "_IVMIEN_" "_$G(^XTMP("IVMERR68",IVMIEN))
. S LINE=LINE+1
;
D ^XMD
K @TEMP
Q
;
COUNT ; For test purposes, check numbers
N IVMDT,STAT,IVMDFN1,IVMIEN,NODE1,IVMYR,SPACE
;
K ^TMP("IVM68TST",$J)
S IVMDT=2960000,STAT=1
; First loop on Income Year
F S IVMDT=$O(^IVM(301.5,"AYR",IVMDT)) Q:'IVMDT D
. S IVMDFN1=0
. ; Second loop on DFN
. F S IVMDFN1=$O(^IVM(301.5,"AYR",IVMDT,IVMDFN1)) Q:'IVMDFN1 D
. . S IVMIEN=$O(^IVM(301.5,"AYR",IVMDT,IVMDFN1,0))
. . Q:'$D(^IVM(301.5,IVMIEN)) ; Quit if not a valid record
. . S NODE1=$G(^IVM(301.5,IVMIEN,1))
. . Q:$P(NODE1,U,1)]"" ; Quit if case already closed
. . S ^TMP("IVM68TST",$J,IVMDT)=$G(^TMP("IVM68TST",$J,IVMDT))+1
;
W @IOF
S $P(SPACE," ",20)=""
W !,"Closing of IVM Cases"
W !!,"Income year"_SPACE_"# of cases closed"
W !,"==========="_SPACE_"================="
;
S IVMYR=0
F S IVMYR=$O(^TMP("IVM68TST",$J,IVMYR)) Q:'IVMYR D
. W !,$$FMTE^XLFDT(IVMYR)_SPACE_$J($FN($G(^TMP("IVM68TST",$J,IVMYR)),","),20)
;
K ^TMP("IVM68TST",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVM268PT 5662 printed Dec 13, 2024@02:00:57 Page 2
IVM268PT ;ALB/SCK - IVM*2*68 POST-INSTALL TO CLOSE IVM CASES ; 10/18/02
+1 ;;2.0;INCOME VERIFICATION MATCH;**68**; 21-OCT-94
+2 ;
+3 ;This routine will be run as part of the post-install for patch
+4 ;IVM*2*68
+5 ;
+6 ;This routine will close all IVM open cases in the IVM PATIENT File,
+7 ;#301.5, for income years 1997 through the present. Patch
+8 ;DG*5.3*272 closed all IVM open cases up through 1996
+9 ;
+10 ; The following fields in the IVM PATIENT File, #301.5 will be updated:
+11 ; .03 - TRANSMISSION STATUS = 1
+12 ; .04 - STOP FLAG = 1
+13 ; 1.01 - CLOSURE REASON = 5 "OLD CASE NO ACTION"
+14 ; 1.02 - CLOSURE SOURCE = 2 "DHCP"
+15 ; 1.03 - CLOSURE DATE/TIME = Current D/T
+16 ;
+17 ;A mail message will be sent to the user when the post-install is complete.
+18 ;Additionally, details and any error messages will be stored in XTMP globals
+19 ;for review.
+20 ;
POST ; Initialize post install
+1 NEW %,I,X,IVMGBL
+2 ;
+3 ; Check post-install closure question
+4 IF $DATA(XPDNM)
IF $DATA(XPDQUES)
if '+XPDQUES("POS001")
QUIT
+5 ; Post-install checkpoints setup
+6 IF $DATA(XPDNM)
Begin DoDot:1
+7 IF $$VERCP^XPDUTL("IVMICY")'>0
Begin DoDot:2
+8 SET %=$$NEWCP^XPDUTL("IVMICY","","2960000")
End DoDot:2
+9 IF $$VERCP^XPDUTL("IVMDFN")'>0
Begin DoDot:2
+10 SET %=$$NEWCP^XPDUTL("IVMDFN","",0)
End DoDot:2
End DoDot:1
+11 ;
QUE ;
+1 NEW ZTRTN,ZTDESC,ZTSAVE,ZTDTH,ZTIO,ZTSK
+2 ;
+3 SET ZTRTN="EN^IVM268PT"
+4 SET ZTDESC="PATCH IVM*2*68 POST INSTALL"
+5 SET ZTSAVE("DUZ")=""
+6 SET ZTDTH=$$NOW^XLFDT
+7 SET ZTIO=""
+8 ;
+9 DO ^%ZTLOAD
+10 IF $DATA(ZTSK)[0
DO BMES^XPDUTL("Post-Install was not tasked off")
+11 IF '$TEST
DO BMES^XPDUTL("Post-Install tasked. ["_ZTSK_"]")
+12 DO HOME^%ZIS
+13 QUIT
+14 ;
EN ;
+1 ; Initialize the XTMP tracking global
+2 IF '$DATA(^XTMP("IVMPCT68"))
Begin DoDot:1
+3 SET ^XTMP("IVMPCT68",0)=$$FMADD^XLFDT($$DT^XLFDT,30)_"^"_$$DT^XLFDT_"^IVM*2*68 POST INSTALL RECORD COUNT"
End DoDot:1
+4 ;
+5 IF '$DATA(^XTMP("IVMERR68"))
Begin DoDot:1
+6 SET ^XTMP("IVMERR68",0)=$$FMADD^XLFDT($$DT^XLFDT,30)_"^"_$$DT^XLFDT_"^IVM*2*68 POST INSTALL FILING ERRORS"
End DoDot:1
+7 ;
+8 ; Begin Processing
+9 NEW DATA,IVMICY,IVMDFN
+10 ;
+11 ;Get values from checkpoints if there was a previous run
+12 IF $DATA(XPDNM)
SET IVMICY=$$PARCP^XPDUTL("IVMICY")
+13 IF $GET(IVMICY)=""
SET IVMICY=2960000
+14 ;
+15 IF $DATA(XPDNM)
SET IVMDFN=$$PARCP^XPDUTL("IVMDFN")
+16 IF $GET(IVMDFN)=""
SET IVMDFN=0
+17 ;
+18 DO BMES^XPDUTL("Beginning case closing process "_$$FMTE^XLFDT($$NOW^XLFDT))
+19 DO CLNUP(IVMICY,IVMDFN)
+20 DO MAIL
+21 ; Close checkpoint
+22 IF $DATA(XPDNM)
Begin DoDot:1
+23 SET %=$$COMCP^XPDUTL("IVMICY")
+24 SET %=$$COMCP^XPDUTL("IVMDFN")
End DoDot:1
+25 DO BMES^XPDUTL("Completed case closing process "_$$FMTE^XLFDT($$NOW^XLFDT))
+26 QUIT
+27 ;
CLNUP(IVMICY,IVMDFN) ; Search for open cases
+1 NEW %,DATA,IVMIEN,IVMDT,IVMDFN1,NODE1,ERROR,IVMOK,IVMABRT
+2 ;
+3 ; Set data array for closing
+4 SET DATA(.03)=1
+5 SET DATA(.04)=1
+6 SET DATA(1.01)=5
+7 SET DATA(1.02)=2
+8 SET DATA(1.03)=$$NOW^XLFDT
+9 ;
+10 SET IVMDT=IVMICY
SET IVMOK=1
+11 ; First loop on Income Year
+12 FOR
SET IVMDT=$ORDER(^IVM(301.5,"AYR",IVMDT))
if 'IVMDT
QUIT
Begin DoDot:1
+13 IF $$S^%ZTLOAD
SET IVMABRT=1
QUIT
+14 SET IVMDFN1=IVMDFN
+15 ; Second loop on DFN
+16 FOR
SET IVMDFN1=$ORDER(^IVM(301.5,"AYR",IVMDT,IVMDFN1))
Begin DoDot:2
+17 IF 'IVMDFN1
Begin DoDot:3
+18 ; Update checkpoint on last DFN for Income Year
+19 IF $DATA(XPDNM)
SET %=$$UPCP^XPDUTL("IVMICY",IVMDT)
End DoDot:3
QUIT
+20 SET IVMIEN=$ORDER(^IVM(301.5,"AYR",IVMDT,IVMDFN1,0))
+21 ; Quit if not a valid record
if '$DATA(^IVM(301.5,IVMIEN))
QUIT
+22 SET NODE1=$GET(^IVM(301.5,IVMIEN,1))
+23 ; Quit if case already closed
if $PIECE(NODE1,U,1)]""
QUIT
+24 ; Close case
+25 SET IVMOK=$$UPD^DGENDBS(301.5,IVMIEN,.DATA,.ERROR)
+26 IF 'IVMOK
SET ^XTMP("IVMERR68",IVMIEN)=$GET(ERROR)
+27 ; Update Counter
+28 SET ^XTMP("IVMPCT68",IVMDT)=$GET(^XTMP("IVMPCT68",IVMDT))+1
+29 ; Update checkpoint for completed DFN
+30 IF $DATA(XPDNM)
SET %=$$UPCP^XPDUTL("IVMDFN",IVMDFN1)
End DoDot:2
if 'IVMDFN1
QUIT
End DoDot:1
if $GET(IVMABRT)
QUIT
+31 QUIT
+32 ;
MAIL ; Send mail message with results
+1 NEW X,XMDUZ,XMTEXT,XMSUB,XMY,Y,TEMP,LINE,IVMYR,SPACE
+2 NEW %,DIFROM
+3 ;
+4 SET TEMP="^TMP(""IVM68"",$J)"
+5 KILL @TEMP
+6 SET XMSUB="Post Install - Closing of IVM Cases"
+7 SET XMDUZ("PATCH IVM-2-68")=""
+8 SET XMY(.5)=""
SET XMY(DUZ)=""
+9 SET XMTEXT="^TMP(""IVM68"",$J,"
+10 ;
+11 SET $PIECE(SPACE," ",20)=""
+12 SET @TEMP@(1)="Closing of IVM Cases"
+13 SET @TEMP@(2)=" "
+14 SET @TEMP@(3)="Income year"_SPACE_"# of cases closed"
+15 SET @TEMP@(4)="==========="_SPACE_"================="
+16 SET LINE=10
+17 SET IVMYR=0
+18 FOR
SET IVMYR=$ORDER(^XTMP("IVMPCT68",IVMYR))
if 'IVMYR
QUIT
Begin DoDot:1
+19 SET @TEMP@(LINE)=$$FMTE^XLFDT(IVMYR)_SPACE_$JUSTIFY($FNUMBER($GET(^XTMP("IVMPCT68",IVMYR)),","),20)
+20 SET LINE=LINE+1
End DoDot:1
+21 ;
+22 ; Add Errors to mail message
+23 SET @TEMP@(LINE)=""
SET LINE=LINE+1
+24 SET @TEMP@(LINE)="Some records may not have been edited due to filing errors."
SET LINE=LINE+1
+25 SET @TEMP@(LINE)="Those records are listed below:"
SET LINE=LINE+1
+26 SET IVMIEN=0
+27 FOR
SET IVMIEN=$ORDER(^XTMP("IVMERR68",IVMIEN))
if 'IVMIEN
QUIT
Begin DoDot:1
+28 SET @TEMP@(LINE)="Record: "_IVMIEN_" "_$GET(^XTMP("IVMERR68",IVMIEN))
+29 SET LINE=LINE+1
End DoDot:1
+30 ;
+31 DO ^XMD
+32 KILL @TEMP
+33 QUIT
+34 ;
COUNT ; For test purposes, check numbers
+1 NEW IVMDT,STAT,IVMDFN1,IVMIEN,NODE1,IVMYR,SPACE
+2 ;
+3 KILL ^TMP("IVM68TST",$JOB)
+4 SET IVMDT=2960000
SET STAT=1
+5 ; First loop on Income Year
+6 FOR
SET IVMDT=$ORDER(^IVM(301.5,"AYR",IVMDT))
if 'IVMDT
QUIT
Begin DoDot:1
+7 SET IVMDFN1=0
+8 ; Second loop on DFN
+9 FOR
SET IVMDFN1=$ORDER(^IVM(301.5,"AYR",IVMDT,IVMDFN1))
if 'IVMDFN1
QUIT
Begin DoDot:2
+10 SET IVMIEN=$ORDER(^IVM(301.5,"AYR",IVMDT,IVMDFN1,0))
+11 ; Quit if not a valid record
if '$DATA(^IVM(301.5,IVMIEN))
QUIT
+12 SET NODE1=$GET(^IVM(301.5,IVMIEN,1))
+13 ; Quit if case already closed
if $PIECE(NODE1,U,1)]""
QUIT
+14 SET ^TMP("IVM68TST",$JOB,IVMDT)=$GET(^TMP("IVM68TST",$JOB,IVMDT))+1
End DoDot:2
End DoDot:1
+15 ;
+16 WRITE @IOF
+17 SET $PIECE(SPACE," ",20)=""
+18 WRITE !,"Closing of IVM Cases"
+19 WRITE !!,"Income year"_SPACE_"# of cases closed"
+20 WRITE !,"==========="_SPACE_"================="
+21 ;
+22 SET IVMYR=0
+23 FOR
SET IVMYR=$ORDER(^TMP("IVM68TST",$JOB,IVMYR))
if 'IVMYR
QUIT
Begin DoDot:1
+24 WRITE !,$$FMTE^XLFDT(IVMYR)_SPACE_$JUSTIFY($FNUMBER($GET(^TMP("IVM68TST",$JOB,IVMYR)),","),20)
End DoDot:1
+25 ;
+26 KILL ^TMP("IVM68TST",$JOB)
+27 QUIT
