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

DG837PST.m

Go to the documentation of this file.
  1. DG837PST ;BIR/PTD/ELZ/CKN-PATCH DG*5.3*837 POST INSTALLATION ROUTINE ; 1/3/12 1:30pm
  1. ;;5.3;Registration;**837**;Aug 13, 1993;Build 5
  1. ;
  1. D IDFLD,ALIAS
  1. D EP ;MVI_791 - Conversion process for TF file #391.91
  1. Q
  1. ;
  1. IDFLD ;MVI_876 (ptd) - Turn on Audit for the new DoD identification fields
  1. ;Do not run module if patch DG*5.3*837 previously installed.
  1. I $$PATCH^XPDUTL("DG*5.3*837") Q
  1. N FLDNUM
  1. S FLDNUM=991.08 D TURNON^DIAUTL(2,FLDNUM)
  1. D BMES^XPDUTL("The TEMPORARY ID NUMBER #"_FLDNUM_" field in the PATIENT file is set to AUDIT.")
  1. S FLDNUM=991.09 D TURNON^DIAUTL(2,FLDNUM)
  1. D BMES^XPDUTL("The FOREIGN ID NUMBER #"_FLDNUM_" field in the PATIENT file is set to AUDIT.")
  1. Q
  1. ;
  1. ALIAS ;MVI_805 (elz) - clean up Alias multiple in patient (#2) file.
  1. ;Do not run module if patch DG*5.3*837 previously installed.
  1. I $$PATCH^XPDUTL("DG*5.3*837") Q
  1. AGAIN ;Line tag to be called if module needs to be run again.
  1. N DGNM,DFN,DGX,FDA,DGERR
  1. D BMES^XPDUTL("Cleaning up duplicate Alias PATIENT file entries.")
  1. K ^TMP("DG837PST",$J)
  1. S DGNM="" F S DGNM=$O(^DPT("B",DGNM)) Q:DGNM="" S DFN=0 F S DFN=$O(^DPT("B",DGNM,DFN)) Q:'DFN I $O(^DPT("B",DGNM,DFN,0)) S ^TMP("DG837PST",$J,DFN)=""
  1. S DFN=0 F S DFN=$O(^TMP("DG837PST",$J,DFN)) Q:'DFN D
  1. . N DGALIAS
  1. . S DGX=0 F S DGX=$O(^DPT(DFN,.01,DGX)) Q:'DGX D
  1. .. S DGALIAS=$P($G(^DPT(DFN,.01,DGX,0)),"^",1,2) Q:DGALIAS=""
  1. .. I '$D(DGALIAS(DGALIAS)) S DGALIAS(DGALIAS)="" Q
  1. .. S FDA(2.01,DGX_","_DFN_",",.01)="@" D FILE^DIE("E","FDA","DGERR")
  1. .. I $G(DGERR("DIERR",1,"TEXT",1))'="" D BMES^XPDUTL("ERROR: DFN"_DFN_" "_DGERR("DIERR",1,"TEXT",1))
  1. D BMES^XPDUTL("Done cleaning up Duplicate Alias entries.")
  1. K ^TMP("DG837PST",$J)
  1. Q
  1. ;
  1. EP ;MVI_791 (ckn) - Post install routine entry point for TF conversion process
  1. N RESTART
  1. S RESTART=0
  1. I '$$CHECK() Q
  1. D QUE
  1. Q
  1. QUE ;Queue the process
  1. N ZTRTN,ZTDESC,ZTSK
  1. S ZTRTN="PROCESS^DG837PST",ZTDESC="DG837PST - CONVERSION PROCESS TREATING FACILITY FILE"
  1. S ZTIO="",ZTDTH=$H
  1. D ^%ZTLOAD
  1. I $D(ZTSK) S ^XTMP("DG837PST","@@","TASK")=ZTSK
  1. S:$D(ZTQUEUED) ZTREQ="@"
  1. Q
  1. CHECK() ;Initial check
  1. D BMES^XPDUTL("Post install conversion process to update TREATING FACILITY FILE #391.91")
  1. N INITSTRT
  1. I '$D(^XTMP("DG837PST","@@","PROCESS INIT STARTED")) S (^XTMP("DG837PST","@@","PROCESS INIT STARTED"),^XTMP("DG837PST","@@","PROCESS STARTED"))=$$NOW^XLFDT() D BMES^XPDUTL("<<Process Started>>") Q 1
  1. I $D(^XTMP("DG837PST","@@","PROCESS COMPLETED")) D BMES^XPDUTL("<<Process is already completed>>")
  1. I $D(^XTMP("DG837PST","@@","PROCESS STOPPED")) D BMES^XPDUTL("<<Process stopped in previous run>>")
  1. I 'RESTART Q 0
  1. W ! S DIR(0)="Y",DIR("B")="Yes",DIR("A")="Do you want to complete the rerun" D ^DIR K DIR
  1. I '+Y Q 0
  1. S INITSTRT=$G(^XTMP("DG837PST","@@","PROCESS INIT STARTED"))
  1. K ^XTMP("DG837PST","@@")
  1. S ^XTMP("DG837PST","@@","PROCESS INIT STARTED")=$G(INITSTRT)
  1. S ^XTMP("DG837PST","@@","PROCESS STARTED")=$$NOW^XLFDT()
  1. D BMES^XPDUTL("<<Process Started>>") Q 1
  1. PROCESS ;
  1. N TFIEN,MIEN,QFLG,X,X1,X2,FDA,FDAIEN,SNODE0,NODE0
  1. S QFLG=0
  1. S X1=DT,X2=60 D C^%DTC
  1. S ^XTMP("DG837PST","@@","TOTAL RECORDS")=$P($G(^DGCN(391.91,0)),"^",4)
  1. S ^XTMP("DG837PST",0)=X_"^"_$$DT^XLFDT_"^DG*5.3*837 - POST INSTALL - CONVERSION PROCESS IN TREATING FACILITY FILE"
  1. S TFIEN=+$G(^XTMP("DG837PST","@@","CURRENT IEN"))
  1. F S TFIEN=$O(^DGCN(391.91,TFIEN)) Q:+TFIEN=0!(QFLG) D
  1. . I $D(^XTMP("DG837PST","@@","FORCE STOP")) S QFLG=1 Q
  1. . S ^XTMP("DG837PST","@@","CURRENT IEN")=TFIEN
  1. . I $O(^DGCN(391.91,TFIEN,1,0))="" D
  1. . . N TMPST
  1. . . S TMPST=$P($G(^DGCN(391.91,TFIEN,0)),"^",2)
  1. . . I $E($$STA^XUAF4(TMPST),1,4)="200N" D Q
  1. . . . N FDA
  1. . . . I $P($G(^DGCN(391.91,TFIEN,2)),"^")'="" S FDA(1,391.91,+TFIEN_",",10)=$P($G(^DGCN(391.91,TFIEN,2)),"^")
  1. . . . I $P($G(^DGCN(391.91,TFIEN,0)),"^",9)="" S FDA(1,391.91,+TFIEN_",",.09)="NI"
  1. . . . D FILE^DIE("K","FDA(1)","ERR")
  1. . . . K FDA
  1. . . I ($E($$STA^XUAF4(TMPST),1,4)'="200N")&(($$STA^XUAF4(TMPST)=200)!($$GET1^DIQ(4,TMPST_",",13)="OTHER")!($$GET1^DIQ(4,TMPST_",",13)="VAMC")) D
  1. . . . N FDA
  1. . . . S FDA(1,391.91,+TFIEN_",",.09)="PI",FDA(1,391.91,+TFIEN_",",10)="USVHA"
  1. . . . D FILE^DIE("K","FDA(1)","ERR")
  1. . . . K FDA
  1. . I $D(^DGCN(391.91,TFIEN,1)) D
  1. . . S MIEN=0 S MIEN=$O(^DGCN(391.91,TFIEN,1,MIEN)) Q:+MIEN=0
  1. . . S SNODE0=$G(^DGCN(391.91,TFIEN,1,MIEN,0))
  1. . . S FDA(1,391.91,+TFIEN_",",11)=$P(SNODE0,"^") ;Source ID
  1. . . S FDA(1,391.91,+TFIEN_",",12)=$P(SNODE0,"^",2) ;Identifier Status
  1. . . D FILE^DIE("K","FDA(1)","ERR")
  1. . . K FDA
  1. . . I $O(^DGCN(391.91,TFIEN,1,MIEN))="" Q ;No more entries in multiple file
  1. . . ; For rest of the entries in multiple file, create new record.
  1. . . S NODE0=$G(^DGCN(391.91,TFIEN,0)),TMPST=$P(NODE0,"^",2)
  1. . . S FDA(1,391.91,"+1,",.01)=$P($G(NODE0),"^",1)
  1. . . S FDA(1,391.91,"+1,",.02)=$P($G(NODE0),"^",2)
  1. . . S FDA(1,391.91,"+1,",.03)=$P($G(NODE0),"^",3)
  1. . . S FDA(1,391.91,"+1,",.07)=$P($G(NODE0),"^",7)
  1. . . S FDA(1,391.91,"+1,",.08)=$P($G(NODE0),"^",8)
  1. . . S FDA(1,391.91,"+1,",.09)=$P($G(NODE0),"^",9)
  1. . . I $E($$STA^XUAF4(TMPST),1,4)="200N" S FDA(1,391.91,"+1,",10)="",FDA(1,391.91,"+1,",.09)="NI"
  1. . . I ($E($$STA^XUAF4(TMPST),1,4)'="200N")&(($$STA^XUAF4(TMPST)=200)!($$GET1^DIQ(4,TMPST_",",13)="OTHER")!($$GET1^DIQ(4,TMPST_",",13)="VAMC")) D
  1. . . . S FDA(1,391.91,"+1,",.09)="PI",FDA(1,391.91,"+1,",10)="USVHA"
  1. . . F S MIEN=$O(^DGCN(391.91,TFIEN,1,MIEN)) Q:+MIEN=0 D
  1. . . . N FDAIEN S SNODE0=$G(^DGCN(391.91,TFIEN,1,MIEN,0))
  1. . . . S FDA(1,391.91,"+1,",11)=$P($G(SNODE0),"^")
  1. . . . S FDA(1,391.91,"+1,",12)=$P($G(SNODE0),"^",2)
  1. . . . D UPDATE^DIE("S","FDA(1)","FDAIEN","ERR")
  1. . . K FDA,FDAIEN
  1. . S DIK="^DGCN(391.91,"_TFIEN_",1,",DA(1)=TFIEN
  1. . S DA=0 F S DA=$O(^DGCN(391.91,TFIEN,1,DA)) Q:+DA=0 D ^DIK
  1. . K DIK,DA
  1. I QFLG S ^XTMP("DG837PST","@@","PROCESS STOPPED")=$$NOW^XLFDT() Q
  1. S ^XTMP("DG837PST","@@","PROCESS COMPLETED")=$$NOW^XLFDT()
  1. D MAIL
  1. D DELDD ;Delete old fields once conversion process is done.
  1. Q
  1. MAIL ;Send Mail message
  1. N PATCH,SITE,STATN,SITENM,MSG,XMDUZ,XMSUB,XMTEXT,XMY
  1. S PATCH="DG*5.3*837"
  1. S SITE=$$SITE^VASITE,STATN=$P($G(SITE),"^",3),SITENM=$P($G(SITE),"^",2)
  1. S (XMY(DUZ),XMY(.5))="",XMY("CHINTAN.NAIK@DOMAIN.EXT")="",XMY("PAULETTE.DAVIS@DOMAIN.EXT")="",XMY("CHRISTINE.CHESNEY@DOMAIN.EXT")=""
  1. S XMDUZ="MPI PATCH MONITOR",XMTEXT="MSG("
  1. S XMSUB="DG*5.3*837 - Conversion process completed for site: "_STATN
  1. S MSG(1)="The DG*5.3*837 post-init conversion process for TREATING FACILITY LIST (#391.91) file completed successfully."
  1. S MSG(1.5)=""
  1. S MSG(2)="Patch: "_PATCH
  1. S MSG(3)="Task: "_$G(^XTMP("DG837PST","@@","TASK"))
  1. S MSG(4)=""
  1. S MSG(5)="Site Station #: "_STATN
  1. S MSG(6)="Site Name: "_SITENM
  1. S MSG(7)=""
  1. S MSG(8)="Process Started at: "_$$FMTE^XLFDT($G(^XTMP("DG837PST","@@","PROCESS INIT STARTED")),"5P")
  1. S MSG(8.5)=""
  1. S MSG(9)="Process Completed at: "_$$FMTE^XLFDT($G(^XTMP("DG837PST","@@","PROCESS COMPLETED")),"5P")
  1. S MSG(9.5)=""
  1. S MSG(10)="Total Records in TREATING FACILITY LIST file (#391.91): "_^XTMP("DG837PST","@@","TOTAL RECORDS")
  1. D ^XMD
  1. Q
  1. STRTAGN ;Re run of process in case of process is stopped
  1. N RESTART
  1. S RESTART=1
  1. I '$$CHECK() Q
  1. D QUE
  1. Q
  1. STOP ;Stop the process
  1. W !!,"Stop process"
  1. I '$D(^XTMP("DG837PST","@@","PROCESS STARTED")) W !,"<< No process is currently running >>" Q
  1. I $D(^XTMP("DG837PST","@@","PROCESS COMPLETED")) W !,"<< Process already completed >>" Q
  1. W !!,"Process is currently running."
  1. W ! S DIR(0)="Y",DIR("B")="Yes",DIR("A")="Do you want to stop this process" D ^DIR K DIR
  1. I +Y S ^XTMP("DG837PST","@@","FORCE STOP")=1
  1. K DIR,Y
  1. Q
  1. ;
  1. DELDD ;MVI_791 (ptd) - Delete obsolete fields in #391.91 file and 391.92.
  1. ;This code should only be called after the conversion
  1. ;routine has moved the data from the obsolete fields
  1. ;to the new fields and deleted the data.
  1. ;
  1. ;Delete these fields from the TREATING FACILITY LIST #391.91 file:
  1. ; ASSIGNING AUTHORITY (#1) field, and
  1. ; SOURCE ID (#20) subfile 391.9101, which includes the
  1. ; SOURCE ID(#.01) and IDENTIFIER STATUS (#1) fields
  1. ;and delete the obsolete VAFC ASSIGNING AUTHORITY (#391.92) file.
  1. ;
  1. ;
  1. D BMES^XPDUTL("Removing obsolete fields from the TREATING FACILITY LIST #391.91 file.")
  1. ;Delete DD definition for the ASSIGNING AUTHORITY (#1)
  1. ;field in the TREATING FACILITY LIST (#391.91) file.
  1. ;
  1. S DIK="^DD(391.91,",DA=1,DA(1)=391.91
  1. D ^DIK
  1. K DA,DIK
  1. D BMES^XPDUTL(">>> Obsolete ASSIGNING AUTHORITY #1 field has been deleted.")
  1. ;
  1. ;Remove SOURCE ID (#391.9101) sub-file in the TREATING FACILITY
  1. ;LIST (#391.91) file. S=subfile.
  1. I $$VFILE^DILFD(391.9101)=1 D ;If sub-file exists, delete it.
  1. .S DIU=391.9101,DIU(0)="S"
  1. .D EN^DIU2
  1. .K DIU
  1. .D BMES^XPDUTL(">>> Obsolete SOURCE ID #391.9101 sub-file has been deleted.")
  1. ;
  1. ;Remove VAFC ASSIGNING AUTHORITY (#391.92) file; D=delete data
  1. I $$VFILE^DILFD(391.92)=1 D ;If file exists, delete it.
  1. .D BMES^XPDUTL("Removing obsolete VAFC ASSIGNING AUTHORITY #391.92 file.")
  1. .S DIU="^DGCN(391.92,",DIU(0)="D"
  1. .D EN^DIU2
  1. .K DIU
  1. .D BMES^XPDUTL(">>> Obsolete VAFC ASSIGNING AUTHORITY #391.92 file has been deleted.")
  1. Q
  1. ;