TIUP301 ; SLC/DJH - Patch 301 post-install routine ; 1/11/17 4:54pm
;;1.0;TEXT INTEGRATION UTILITIES;**301**;;Build 15
;;Per VA Directive 6402, this routine should not be modified.
Q
; TIU*1.0*301
; This routine sets the parameter 'UPLOAD FILING ERROR CODE'
; from 'D GETPN^TIUCHLP' to 'D CNFIX^TIUCNFIX' for all CONSULTS
; document types & from 'D GETPN^TIUCHLP' to 'D PNFIX^TIUPNFIX'
; for all PROGRESS NOTES document types. This is to resolve
; issues caused by facilities who didn't complete the post install
; instructions for patch TIU*1.0*131 or didn't complete the
; instructions because they didn't upload CONSULTS or PROGRESS NOTES
; when patch 131 was installed.
;
; EXTERNAL REFERENCES
; $$FIND1^DIC
; $$GET1^DIQ
; $$HTE^XLFDT
; $$NOW^XLFDT
; $$FMADD^XLFDT
; $$FMTH^XLFDT
; $$FMTE^XLFDT
; BMES^XPDUTL
; MES^XPDUTL
; FILE^DIE
; ^XMD
EN ;
N IEN,TIUIEN,TIUIEN2,TIUCONS,TIUPN,IND,TIUDOCN,CNT,BEGDT,TXT
N NAMSP,TIUBADV,TIUPARAM,MSG,TYPE,PATCH,JOBN,IND,DOCTYPE
N PURGDT,TEXT,TIUCURR,TIUMSG,FDARR,IENS,ERR,FLAGS,REPORT
S NAMSP=$$NAMSP,PATCH="TIU*1.0*301"
S JOBN="TIU PATCH 301 INSTALL"
S IND=$J(" ",8),CNT=1000,MSG(CNT)="",CNT=CNT+1
S TIUBADV="D GETPN^TIUCHLP" ; Bad param value
; Get the IENs for PATIENT RECORD FLAG CAT I/II Doc Class
;
; INITIALIZE ^XTMP
S BEGDT=$$NOW^XLFDT,PURGDT=$$FMADD^XLFDT(BEGDT,365) ;365 day life
S ^XTMP(NAMSP,0)=PURGDT_"^"_BEGDT_"^"_PATCH
S ^XTMP(NAMSP,0,"STATUS")="RUN^"_$$NOW^XLFDT_"^^^"
;
D MESSHDR ; Build message header
;
; PROCESS CONSULTS
S TIUCONS=$$FIND1^DIC(8925.1,"","X","CONSULTS","B") ; Consults IEN
S MSG(CNT)="CONSULTS:",CNT=CNT+1
S TYPE=TIUCONS
S TIUPARAM="D CNFIX^TIUCNFIX"
S DOCTYPE=$$GET1^DIQ(8925.1,TIUCONS,.04)
;Consults is a stand-alone class
I DOCTYPE="CLASS" D
. D FIX(TYPE) ;fix CL record first
. D GETCL
; Consults is a Document Class
I DOCTYPE'="CLASS" D
. D FIX(TYPE) ;fix DC record first
. S TIUIEN=TYPE
. D GETDOC
;
; PROCESS PROGRESS NOTES
S TIUPN=$$FIND1^DIC(8925.1,"","X","PROGRESS NOTES","B") ; Progress Notes CL IEN
S MSG(CNT)="PROGRESS NOTES:",CNT=CNT+1
S TYPE=TIUPN
S TIUPARAM="D PNFIX^TIUPNFIX"
D FIX(TYPE) ; First fix CL record
D GETCL
;
D MAIL
Q
;
; =============== SUBROUTINES =================
;
MESSHDR ; Build message header
S MSG(CNT)="PATCH TIU*1.0*301 INSTALL",CNT=CNT+1
S MSG(CNT)=" UPLOAD FILING ERROR CODE (Field 4.8) Review:",CNT=CNT+1
S MSG(CNT)="",CNT=CNT+1
S MSG(CNT)=" IEN Document Name (Type)",CNT=CNT+1
S MSG(CNT)=" Result",CNT=CNT+1
S MSG(CNT)="--------------------------------------------",CNT=CNT+1
Q
;
GETCL ; Find all DOCUMENT CLASSES within the Class
S TIUIEN=0
F S TIUIEN=$O(^TIU(8925.1,TYPE,10,"B",TIUIEN)) Q:'TIUIEN D
. ;Skip Consults
. Q:TIUIEN=TIUCONS
. D:$$GET1^DIQ(8925.1,TIUIEN,4.8)'="" FIX(TIUIEN)
. D GETDOC
Q
;
GETDOC ; Find all DOCUMENTS within the Document Class
S TIUIEN2=0
F S TIUIEN2=$O(^TIU(8925.1,TIUIEN,10,"B",TIUIEN2)) Q:'TIUIEN2 D
. Q:TIUIEN2=TIUCONS
. Q:$$GET1^DIQ(8925.1,TIUIEN2,4.8)="" ; No value
. D FIX(TIUIEN2)
Q
;
FIX(IEN) ;
S TIUDOCN=$$GET1^DIQ(8925.1,IEN,.01)_" ("_$$GET1^DIQ(8925.1,IEN,.04)_")"
S TIUCURR=$$GET1^DIQ(8925.1,IEN,4.8) ; current value in field 4.8
S REPORT=0
;
I TIUCURR'=TIUPARAM,TIUCURR'=TIUBADV Q
;
S MSG(CNT)=$J(IEN,6)_" "_TIUDOCN,CNT=CNT+1
;
I TIUCURR=TIUPARAM D
. S MSG(CNT)=IND_"No change. Value is already "_TIUPARAM,CNT=CNT+1
;
I TIUCURR=TIUBADV D
. S IENS=""""_IEN_","""
. S FDARR="FDA(8925.1,"_IENS_")",FLAGS="K"
. S @FDARR@(4.8)=TIUPARAM
. D FILE^DIE(FLAGS,"FDA","TIUMSG")
. I '$D(TIUMSG) S MSG(CNT)=IND_TIUCURR_" changed to "_TIUPARAM,CNT=CNT+1 Q
. S ERR=0 F S ERR=$O(TIUMSG("DIERR",1,"TEXT",ERR)) Q:ERR="" D
. . S MSG(CNT)=IND_TIUMSG("DIERR",1,"TEXT",ERR),CNT=CNT+1
. S MSG(CNT)=IND_"Needs to be manually updated to "_TIUPARAM,CNT=CNT+1
Q
;
MAIL ;
N XMY,XMDUZ,DIFROM,XMSUB,XMTEXT,NMSP,VAR
S XMY(DUZ)=""
S XMY("G.TIU CACS")=""
S XMY("G.PATIENT SAFETY NOTIFICATIONS")=""
S XMSUB="PATCH TIU*1.0*301 INSTALL",XMTEXT="MSG(",XMDUZ="Patch TIU*1.0*301"
S CNT=1
S MSG(CNT)="PATCH TIU*1.0*301 completed processing.",CNT=CNT+1
S MSG(CNT)="",CNT=CNT+1
S MSG(CNT)="This patch reviewed field 4.8 (UPLOAD FILING ERROR CODE) in TIU DOCUMENT",CNT=CNT+1
S MSG(CNT)="DEFINITIONS for document classes and titles belonging to CONSULTS and PROGRESS",CNT=CNT+1
S MSG(CNT)="NOTES. Any values that equaled the pre-patch TIU*1.0*131 value of",CNT=CNT+1
S MSG(CNT)="'D GETPN^TIUCHLP' and were not in use at the time of the install ('locked')",CNT=CNT+1
S MSG(CNT)="were updated as follows:",CNT=CNT+1
S MSG(CNT)=" 1. CONSULTS were changed to 'D CNFIX^TIUCNFIX', PROGRESS NOTES were changed",CNT=CNT+1
S MSG(CNT)=" to 'D PNFIX^TIUPNFIX'.",CNT=CNT+1
S MSG(CNT)=" 2. Any classes or titles that were locked during the install NEED TO",CNT=CNT+1
S MSG(CNT)=" BE MANUALLY UPDATED using option TIU UPLOAD PARAMETER EDIT.",CNT=CNT+1
S MSG(CNT)=" 3. Any values other than 'D GETPN^TIUCHLP' were not changed and are noted",CNT=CNT+1
S MSG(CNT)=" only in the install file for historical purposes and no action to them",CNT=CNT+1
S MSG(CNT)=" is required with this patch.",CNT=CNT+1
S MSG(CNT)=" 4. Any field 4.8 without a value were not changed and are not listed.",CNT=CNT+1
S MSG(CNT)="",CNT=CNT+1
S MSG(CNT)="**IMPORTANT NOTE** The 'Enhanced Mismatched Consults List' [TIU144",CNT=CNT+1
S MSG(CNT)="ENHANCED MISMATCH LIST] should be run regularly. Please take a moment now",CNT=CNT+1
S MSG(CNT)="to run it and create a reminder in your calendar to run it again every",CNT=CNT+1
S MSG(CNT)="6 months. If there are any mismatches submit a help desk ticket for",CNT=CNT+1
S MSG(CNT)="assistance resolving them.",CNT=CNT+1
;
D ^XMD
Q
;
NAMSP() ;
Q $T(+0)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUP301 5954 printed Apr 09, 2024@21:44:10 Page 2
TIUP301 ; SLC/DJH - Patch 301 post-install routine ; 1/11/17 4:54pm
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**301**;;Build 15
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ; TIU*1.0*301
+5 ; This routine sets the parameter 'UPLOAD FILING ERROR CODE'
+6 ; from 'D GETPN^TIUCHLP' to 'D CNFIX^TIUCNFIX' for all CONSULTS
+7 ; document types & from 'D GETPN^TIUCHLP' to 'D PNFIX^TIUPNFIX'
+8 ; for all PROGRESS NOTES document types. This is to resolve
+9 ; issues caused by facilities who didn't complete the post install
+10 ; instructions for patch TIU*1.0*131 or didn't complete the
+11 ; instructions because they didn't upload CONSULTS or PROGRESS NOTES
+12 ; when patch 131 was installed.
+13 ;
+14 ; EXTERNAL REFERENCES
+15 ; $$FIND1^DIC
+16 ; $$GET1^DIQ
+17 ; $$HTE^XLFDT
+18 ; $$NOW^XLFDT
+19 ; $$FMADD^XLFDT
+20 ; $$FMTH^XLFDT
+21 ; $$FMTE^XLFDT
+22 ; BMES^XPDUTL
+23 ; MES^XPDUTL
+24 ; FILE^DIE
+25 ; ^XMD
EN ;
+1 NEW IEN,TIUIEN,TIUIEN2,TIUCONS,TIUPN,IND,TIUDOCN,CNT,BEGDT,TXT
+2 NEW NAMSP,TIUBADV,TIUPARAM,MSG,TYPE,PATCH,JOBN,IND,DOCTYPE
+3 NEW PURGDT,TEXT,TIUCURR,TIUMSG,FDARR,IENS,ERR,FLAGS,REPORT
+4 SET NAMSP=$$NAMSP
SET PATCH="TIU*1.0*301"
+5 SET JOBN="TIU PATCH 301 INSTALL"
+6 SET IND=$JUSTIFY(" ",8)
SET CNT=1000
SET MSG(CNT)=""
SET CNT=CNT+1
+7 ; Bad param value
SET TIUBADV="D GETPN^TIUCHLP"
+8 ; Get the IENs for PATIENT RECORD FLAG CAT I/II Doc Class
+9 ;
+10 ; INITIALIZE ^XTMP
+11 ;365 day life
SET BEGDT=$$NOW^XLFDT
SET PURGDT=$$FMADD^XLFDT(BEGDT,365)
+12 SET ^XTMP(NAMSP,0)=PURGDT_"^"_BEGDT_"^"_PATCH
+13 SET ^XTMP(NAMSP,0,"STATUS")="RUN^"_$$NOW^XLFDT_"^^^"
+14 ;
+15 ; Build message header
DO MESSHDR
+16 ;
+17 ; PROCESS CONSULTS
+18 ; Consults IEN
SET TIUCONS=$$FIND1^DIC(8925.1,"","X","CONSULTS","B")
+19 SET MSG(CNT)="CONSULTS:"
SET CNT=CNT+1
+20 SET TYPE=TIUCONS
+21 SET TIUPARAM="D CNFIX^TIUCNFIX"
+22 SET DOCTYPE=$$GET1^DIQ(8925.1,TIUCONS,.04)
+23 ;Consults is a stand-alone class
+24 IF DOCTYPE="CLASS"
Begin DoDot:1
+25 ;fix CL record first
DO FIX(TYPE)
+26 DO GETCL
End DoDot:1
+27 ; Consults is a Document Class
+28 IF DOCTYPE'="CLASS"
Begin DoDot:1
+29 ;fix DC record first
DO FIX(TYPE)
+30 SET TIUIEN=TYPE
+31 DO GETDOC
End DoDot:1
+32 ;
+33 ; PROCESS PROGRESS NOTES
+34 ; Progress Notes CL IEN
SET TIUPN=$$FIND1^DIC(8925.1,"","X","PROGRESS NOTES","B")
+35 SET MSG(CNT)="PROGRESS NOTES:"
SET CNT=CNT+1
+36 SET TYPE=TIUPN
+37 SET TIUPARAM="D PNFIX^TIUPNFIX"
+38 ; First fix CL record
DO FIX(TYPE)
+39 DO GETCL
+40 ;
+41 DO MAIL
+42 QUIT
+43 ;
+44 ; =============== SUBROUTINES =================
+45 ;
MESSHDR ; Build message header
+1 SET MSG(CNT)="PATCH TIU*1.0*301 INSTALL"
SET CNT=CNT+1
+2 SET MSG(CNT)=" UPLOAD FILING ERROR CODE (Field 4.8) Review:"
SET CNT=CNT+1
+3 SET MSG(CNT)=""
SET CNT=CNT+1
+4 SET MSG(CNT)=" IEN Document Name (Type)"
SET CNT=CNT+1
+5 SET MSG(CNT)=" Result"
SET CNT=CNT+1
+6 SET MSG(CNT)="--------------------------------------------"
SET CNT=CNT+1
+7 QUIT
+8 ;
GETCL ; Find all DOCUMENT CLASSES within the Class
+1 SET TIUIEN=0
+2 FOR
SET TIUIEN=$ORDER(^TIU(8925.1,TYPE,10,"B",TIUIEN))
if 'TIUIEN
QUIT
Begin DoDot:1
+3 ;Skip Consults
+4 if TIUIEN=TIUCONS
QUIT
+5 if $$GET1^DIQ(8925.1,TIUIEN,4.8)'=""
DO FIX(TIUIEN)
+6 DO GETDOC
End DoDot:1
+7 QUIT
+8 ;
GETDOC ; Find all DOCUMENTS within the Document Class
+1 SET TIUIEN2=0
+2 FOR
SET TIUIEN2=$ORDER(^TIU(8925.1,TIUIEN,10,"B",TIUIEN2))
if 'TIUIEN2
QUIT
Begin DoDot:1
+3 if TIUIEN2=TIUCONS
QUIT
+4 ; No value
if $$GET1^DIQ(8925.1,TIUIEN2,4.8)=""
QUIT
+5 DO FIX(TIUIEN2)
End DoDot:1
+6 QUIT
+7 ;
FIX(IEN) ;
+1 SET TIUDOCN=$$GET1^DIQ(8925.1,IEN,.01)_" ("_$$GET1^DIQ(8925.1,IEN,.04)_")"
+2 ; current value in field 4.8
SET TIUCURR=$$GET1^DIQ(8925.1,IEN,4.8)
+3 SET REPORT=0
+4 ;
+5 IF TIUCURR'=TIUPARAM
IF TIUCURR'=TIUBADV
QUIT
+6 ;
+7 SET MSG(CNT)=$JUSTIFY(IEN,6)_" "_TIUDOCN
SET CNT=CNT+1
+8 ;
+9 IF TIUCURR=TIUPARAM
Begin DoDot:1
+10 SET MSG(CNT)=IND_"No change. Value is already "_TIUPARAM
SET CNT=CNT+1
End DoDot:1
+11 ;
+12 IF TIUCURR=TIUBADV
Begin DoDot:1
+13 SET IENS=""""_IEN_","""
+14 SET FDARR="FDA(8925.1,"_IENS_")"
SET FLAGS="K"
+15 SET @FDARR@(4.8)=TIUPARAM
+16 DO FILE^DIE(FLAGS,"FDA","TIUMSG")
+17 IF '$DATA(TIUMSG)
SET MSG(CNT)=IND_TIUCURR_" changed to "_TIUPARAM
SET CNT=CNT+1
QUIT
+18 SET ERR=0
FOR
SET ERR=$ORDER(TIUMSG("DIERR",1,"TEXT",ERR))
if ERR=""
QUIT
Begin DoDot:2
+19 SET MSG(CNT)=IND_TIUMSG("DIERR",1,"TEXT",ERR)
SET CNT=CNT+1
End DoDot:2
+20 SET MSG(CNT)=IND_"Needs to be manually updated to "_TIUPARAM
SET CNT=CNT+1
End DoDot:1
+21 QUIT
+22 ;
MAIL ;
+1 NEW XMY,XMDUZ,DIFROM,XMSUB,XMTEXT,NMSP,VAR
+2 SET XMY(DUZ)=""
+3 SET XMY("G.TIU CACS")=""
+4 SET XMY("G.PATIENT SAFETY NOTIFICATIONS")=""
+5 SET XMSUB="PATCH TIU*1.0*301 INSTALL"
SET XMTEXT="MSG("
SET XMDUZ="Patch TIU*1.0*301"
+6 SET CNT=1
+7 SET MSG(CNT)="PATCH TIU*1.0*301 completed processing."
SET CNT=CNT+1
+8 SET MSG(CNT)=""
SET CNT=CNT+1
+9 SET MSG(CNT)="This patch reviewed field 4.8 (UPLOAD FILING ERROR CODE) in TIU DOCUMENT"
SET CNT=CNT+1
+10 SET MSG(CNT)="DEFINITIONS for document classes and titles belonging to CONSULTS and PROGRESS"
SET CNT=CNT+1
+11 SET MSG(CNT)="NOTES. Any values that equaled the pre-patch TIU*1.0*131 value of"
SET CNT=CNT+1
+12 SET MSG(CNT)="'D GETPN^TIUCHLP' and were not in use at the time of the install ('locked')"
SET CNT=CNT+1
+13 SET MSG(CNT)="were updated as follows:"
SET CNT=CNT+1
+14 SET MSG(CNT)=" 1. CONSULTS were changed to 'D CNFIX^TIUCNFIX', PROGRESS NOTES were changed"
SET CNT=CNT+1
+15 SET MSG(CNT)=" to 'D PNFIX^TIUPNFIX'."
SET CNT=CNT+1
+16 SET MSG(CNT)=" 2. Any classes or titles that were locked during the install NEED TO"
SET CNT=CNT+1
+17 SET MSG(CNT)=" BE MANUALLY UPDATED using option TIU UPLOAD PARAMETER EDIT."
SET CNT=CNT+1
+18 SET MSG(CNT)=" 3. Any values other than 'D GETPN^TIUCHLP' were not changed and are noted"
SET CNT=CNT+1
+19 SET MSG(CNT)=" only in the install file for historical purposes and no action to them"
SET CNT=CNT+1
+20 SET MSG(CNT)=" is required with this patch."
SET CNT=CNT+1
+21 SET MSG(CNT)=" 4. Any field 4.8 without a value were not changed and are not listed."
SET CNT=CNT+1
+22 SET MSG(CNT)=""
SET CNT=CNT+1
+23 SET MSG(CNT)="**IMPORTANT NOTE** The 'Enhanced Mismatched Consults List' [TIU144"
SET CNT=CNT+1
+24 SET MSG(CNT)="ENHANCED MISMATCH LIST] should be run regularly. Please take a moment now"
SET CNT=CNT+1
+25 SET MSG(CNT)="to run it and create a reminder in your calendar to run it again every"
SET CNT=CNT+1
+26 SET MSG(CNT)="6 months. If there are any mismatches submit a help desk ticket for"
SET CNT=CNT+1
+27 SET MSG(CNT)="assistance resolving them."
SET CNT=CNT+1
+28 ;
+29 DO ^XMD
+30 QUIT
+31 ;
NAMSP() ;
+1 QUIT $TEXT(+0)
