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