Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IVM268PT

IVM268PT.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ;This routine will be run as part of the post-install for patch
  1.  ;IVM*2*68
  1.  ;
  1.  ;This routine will close all IVM open cases in the IVM PATIENT File,
  1.  ;#301.5, for income years 1997 through the present.  Patch 
  1.  ;DG*5.3*272 closed all IVM open cases up through 1996
  1.  ;
  1.  ; The following fields in the IVM PATIENT File, #301.5 will be updated:
  1.  ;   .03  -  TRANSMISSION STATUS = 1
  1.  ;   .04  -  STOP FLAG           = 1
  1.  ;  1.01  -  CLOSURE REASON      = 5 "OLD CASE NO ACTION"
  1.  ;  1.02  -  CLOSURE SOURCE      = 2 "DHCP"
  1.  ;  1.03  -  CLOSURE DATE/TIME   = Current D/T
  1.  ;
  1.  ;A mail message will be sent to the user when the post-install is complete.
  1.  ;Additionally, details and any error messages will be stored in XTMP globals
  1.  ;for review.
  1.  ;
  1. POST ; Initialize post install
  1.  N %,I,X,IVMGBL
  1.  ;
  1.  ; Check post-install closure question
  1.  I $D(XPDNM),$D(XPDQUES) Q:'+XPDQUES("POS001")
  1.  ; Post-install checkpoints setup
  1.  I $D(XPDNM) D
  1.  . I $$VERCP^XPDUTL("IVMICY")'>0 D
  1.  . . S %=$$NEWCP^XPDUTL("IVMICY","","2960000")
  1.  . I $$VERCP^XPDUTL("IVMDFN")'>0 D
  1.  . . S %=$$NEWCP^XPDUTL("IVMDFN","",0)
  1.  ;
  1. QUE ;
  1.  N ZTRTN,ZTDESC,ZTSAVE,ZTDTH,ZTIO,ZTSK
  1.  ;
  1.  S ZTRTN="EN^IVM268PT"
  1.  S ZTDESC="PATCH IVM*2*68 POST INSTALL"
  1.  S ZTSAVE("DUZ")=""
  1.  S ZTDTH=$$NOW^XLFDT
  1.  S ZTIO=""
  1.  ;
  1.  D ^%ZTLOAD
  1.  I $D(ZTSK)[0 D BMES^XPDUTL("Post-Install was not tasked off")
  1.  E  D BMES^XPDUTL("Post-Install tasked. ["_ZTSK_"]")
  1.  D HOME^%ZIS
  1.  Q
  1.  ;
  1. EN ;
  1.  ; Initialize the XTMP tracking global
  1.  I '$D(^XTMP("IVMPCT68")) D
  1.  . S ^XTMP("IVMPCT68",0)=$$FMADD^XLFDT($$DT^XLFDT,30)_"^"_$$DT^XLFDT_"^IVM*2*68 POST INSTALL RECORD COUNT"
  1.  ;
  1.  I '$D(^XTMP("IVMERR68")) D
  1.  . S ^XTMP("IVMERR68",0)=$$FMADD^XLFDT($$DT^XLFDT,30)_"^"_$$DT^XLFDT_"^IVM*2*68 POST INSTALL FILING ERRORS"
  1.  ;
  1.  ; Begin Processing
  1.  N DATA,IVMICY,IVMDFN
  1.  ;
  1.  ;Get values from checkpoints if there was a previous run
  1.  I $D(XPDNM) S IVMICY=$$PARCP^XPDUTL("IVMICY")
  1.  I $G(IVMICY)="" S IVMICY=2960000
  1.  ;
  1.  I $D(XPDNM) S IVMDFN=$$PARCP^XPDUTL("IVMDFN")
  1.  I $G(IVMDFN)="" S IVMDFN=0
  1.  ;
  1.  D BMES^XPDUTL("Beginning case closing process "_$$FMTE^XLFDT($$NOW^XLFDT))
  1.  D CLNUP(IVMICY,IVMDFN)
  1.  D MAIL
  1.  ; Close checkpoint
  1.  I $D(XPDNM) D
  1.  . S %=$$COMCP^XPDUTL("IVMICY")
  1.  . S %=$$COMCP^XPDUTL("IVMDFN")
  1.  D BMES^XPDUTL("Completed case closing process "_$$FMTE^XLFDT($$NOW^XLFDT))
  1.  Q
  1.  ;
  1. CLNUP(IVMICY,IVMDFN) ; Search for open cases
  1.  N %,DATA,IVMIEN,IVMDT,IVMDFN1,NODE1,ERROR,IVMOK,IVMABRT
  1.  ;
  1.  ; Set data array for closing
  1.  S DATA(.03)=1
  1.  S DATA(.04)=1
  1.  S DATA(1.01)=5
  1.  S DATA(1.02)=2
  1.  S DATA(1.03)=$$NOW^XLFDT
  1.  ;
  1.  S IVMDT=IVMICY,IVMOK=1
  1.  ; First loop on Income Year
  1.  F  S IVMDT=$O(^IVM(301.5,"AYR",IVMDT)) Q:'IVMDT  D  Q:$G(IVMABRT)
  1.  . I $$S^%ZTLOAD S IVMABRT=1 Q
  1.  . S IVMDFN1=IVMDFN
  1.  . ; Second loop on DFN
  1.  . F  S IVMDFN1=$O(^IVM(301.5,"AYR",IVMDT,IVMDFN1)) D  Q:'IVMDFN1
  1.  . . I 'IVMDFN1 D  Q
  1.  . . . ; Update checkpoint on last DFN for Income Year
  1.  . . . I $D(XPDNM) S %=$$UPCP^XPDUTL("IVMICY",IVMDT)
  1.  . . S IVMIEN=$O(^IVM(301.5,"AYR",IVMDT,IVMDFN1,0))
  1.  . . Q:'$D(^IVM(301.5,IVMIEN))  ; Quit if not a valid record
  1.  . . S NODE1=$G(^IVM(301.5,IVMIEN,1))
  1.  . . Q:$P(NODE1,U,1)]""  ; Quit if case already closed
  1.  . . ; Close case
  1.  . . S IVMOK=$$UPD^DGENDBS(301.5,IVMIEN,.DATA,.ERROR)
  1.  . . I 'IVMOK S ^XTMP("IVMERR68",IVMIEN)=$G(ERROR)
  1.  . . ; Update Counter
  1.  . . S ^XTMP("IVMPCT68",IVMDT)=$G(^XTMP("IVMPCT68",IVMDT))+1
  1.  . . ; Update checkpoint for completed DFN
  1.  . . I $D(XPDNM) S %=$$UPCP^XPDUTL("IVMDFN",IVMDFN1)
  1.  Q
  1.  ;
  1. MAIL ; Send mail message with results
  1.  N X,XMDUZ,XMTEXT,XMSUB,XMY,Y,TEMP,LINE,IVMYR,SPACE
  1.  N %,DIFROM
  1.  ;
  1.  S TEMP="^TMP(""IVM68"",$J)"
  1.  K @TEMP
  1.  S XMSUB="Post Install - Closing of IVM Cases"
  1.  S XMDUZ("PATCH IVM-2-68")=""
  1.  S XMY(.5)="",XMY(DUZ)=""
  1.  S XMTEXT="^TMP(""IVM68"",$J,"
  1.  ;
  1.  S $P(SPACE," ",20)=""
  1.  S @TEMP@(1)="Closing of IVM Cases"
  1.  S @TEMP@(2)=" "
  1.  S @TEMP@(3)="Income year"_SPACE_"# of cases closed"
  1.  S @TEMP@(4)="==========="_SPACE_"================="
  1.  S LINE=10
  1.  S IVMYR=0
  1.  F  S IVMYR=$O(^XTMP("IVMPCT68",IVMYR)) Q:'IVMYR  D
  1.  . S @TEMP@(LINE)=$$FMTE^XLFDT(IVMYR)_SPACE_$J($FN($G(^XTMP("IVMPCT68",IVMYR)),","),20)
  1.  . S LINE=LINE+1
  1.  ;
  1.  ;  Add Errors to mail message
  1.  S @TEMP@(LINE)="",LINE=LINE+1
  1.  S @TEMP@(LINE)="Some records may not have been edited due to filing errors.",LINE=LINE+1
  1.  S @TEMP@(LINE)="Those records are listed below:",LINE=LINE+1
  1.  S IVMIEN=0
  1.  F  S IVMIEN=$O(^XTMP("IVMERR68",IVMIEN)) Q:'IVMIEN  D
  1.  . S @TEMP@(LINE)="Record: "_IVMIEN_"  "_$G(^XTMP("IVMERR68",IVMIEN))
  1.  . S LINE=LINE+1
  1.  ;
  1.  D ^XMD
  1.  K @TEMP
  1.  Q
  1.  ;
  1. COUNT ;  For test purposes, check numbers
  1.  N IVMDT,STAT,IVMDFN1,IVMIEN,NODE1,IVMYR,SPACE
  1.  ;
  1.  K ^TMP("IVM68TST",$J)
  1.  S IVMDT=2960000,STAT=1
  1.  ; First loop on Income Year
  1.  F  S IVMDT=$O(^IVM(301.5,"AYR",IVMDT)) Q:'IVMDT  D
  1.  . S IVMDFN1=0
  1.  . ; Second loop on DFN
  1.  . F  S IVMDFN1=$O(^IVM(301.5,"AYR",IVMDT,IVMDFN1)) Q:'IVMDFN1  D
  1.  . . S IVMIEN=$O(^IVM(301.5,"AYR",IVMDT,IVMDFN1,0))
  1.  . . Q:'$D(^IVM(301.5,IVMIEN))  ; Quit if not a valid record
  1.  . . S NODE1=$G(^IVM(301.5,IVMIEN,1))
  1.  . . Q:$P(NODE1,U,1)]""  ; Quit if case already closed
  1.  . . S ^TMP("IVM68TST",$J,IVMDT)=$G(^TMP("IVM68TST",$J,IVMDT))+1
  1.  ;
  1.  W @IOF
  1.  S $P(SPACE," ",20)=""
  1.  W !,"Closing of IVM Cases"
  1.  W !!,"Income year"_SPACE_"# of cases closed"
  1.  W !,"==========="_SPACE_"================="
  1.  ;
  1.  S IVMYR=0
  1.  F  S IVMYR=$O(^TMP("IVM68TST",$J,IVMYR)) Q:'IVMYR  D
  1.  . W !,$$FMTE^XLFDT(IVMYR)_SPACE_$J($FN($G(^TMP("IVM68TST",$J,IVMYR)),","),20)
  1.  ;
  1.  K ^TMP("IVM68TST",$J)
  1.  Q