DG944PST ;BIR/CML-PATCH DG*5.3*944 POST INSTALLATION ROUTINE ;5/1/17
;;5.3;Registration;**944**;Aug 13, 1993;Build 2
;
; - Story 500994 (cml)
; This post-init will loop thru the Patient file (^DPT(DFN)) and check the zero node looking for any names
; that contain lowercase letters.
; Any that are found will be updated to all uppercase and saved into the .01 field of the PATIENT (#2) file.
; When the job is complete it will send an email to:
; - (locally) POSTMASTER and the person who installed the patch (DUZ)
; - (MPI Outlook) Christine.Chesney@domain.ext, Link.Christine@domain.ext and John.Williams30ec0c@domain.ext.
;
; - Story 557843 (cml)
; This post-init will loop thru the Patient file (^DPT(DFN)) and check for any records that have an ICN and
; an ICN CHECKSUM but do NOT have the FULL ICN field populated.
; Any that are found will have the FULL ICN field updated to be ICN_"V"_CHECKSUM.
; When the job is complete it will send an email to:
; - (locally) POSTMASTER and the person who installed the patch (DUZ)
; - (MPI Outlook) Christine.Chesney@domain.ext, Link.Christine@domain.ext and John.Williams30ec0c@domain.ext.
;
; - Story 557808 (jfw)
; Add 'Department of Defense' entry to the SOURCE OF NOTIFICATION File (#47.76).
;
; - Story 557909 (jfw)
; Enable auditing on the PLACE OF BIRTH CITY (.092)/STATE (.093) fields
; in the PATIENT file (#2).
;
; - Stories 557815 and 557804 (elz)
; Populate the new Source of Notification Business Rules (#47.761) file with initial
; business rules for both Source of Notification and Document Types allowed
;
;
POST ;queue off post-init to identify and cleanup any names with lowercase characters or missing FULL ICN
N DGI,DGFLDS
; Modifying the following field(s) in the PATIENT File #2:
; - .092 PLACE OF BIRTH [CITY]
; - .093 PLACE OF BIRTH [STATE]
S DGFLDS=".092,.093"
D BMES^XPDUTL("Post-Install:"),MES^XPDUTL("")
;Turning on AUDITING for PATIENT File field(s)
F DGI=1:1:$L(DGFLDS,",") D AUDIT(2,$P(DGFLDS,",",DGI),"PATIENT")
D UPDTFLE ;Add new Source of Notification
D BRFILE ;Add the DOD Source/Document type business rules into the new file
D QUE ;Task off cleanup of lowercase letters in names or missing FULL ICN
D BMES^XPDUTL("Post-Install: Finished")
Q
;
AUDIT(DGFILE,DGFLD,DGFNAME) ;Turn on Auditing for Field in File
D TURNON^DIAUTL(DGFILE,DGFLD) ;DBIA #4397 Supported
D MES^XPDUTL(" Enabled AUDIT on file #"_DGFILE_" ("_DGFNAME_"), field #"_DGFLD)
Q
;
UPDTFLE ;Create a new entry in SOURCE OF NOTIFICATIONS file (#47.76)
N DGFDA,DGERRMSG
D BMES^XPDUTL(" Add A New Source Of Notification (Department of Defense) to File #47.76.")
I $$FIND1^DIC(47.76,"","X","Department of Defense") D MES^XPDUTL(" *** 'Department of Defense' Source of Notification entry already exists!") Q
S DGFDA(47.76,"+1,",.01)="Department of Defense"
S DGFDA(47.76,"+1,",1)=14
S DGFDA(47.76,"+1,",2)=1
D UPDATE^DIE("","DGFDA","","DGERRMSG")
I $D(DGERRMSG) D MES^XPDUTL(" >>> ERROR! 'Department of Defense' Source of Notification NOT added!"),MES^XPDUTL(" [#"_DGERRMSG("DIERR",1)_": "_DGERRMSG("DIERR",1,"TEXT",1)_"]") Q
D MES^XPDUTL(" *** 'Department of Defense' Source of Notification successfully added to")
D MES^XPDUTL(" File #47.76!")
Q
;
QUE ; Queue off the cleanup of names with lowercase letters and missing FULL ICNs
D BMES^XPDUTL(" Queuing job to clean up lowercase names and missing FULL ICNs.")
N ZTIO,ZTSK,ZTRTN,ZTDESC,ZTSAVE,ZTDTH,Y
S ZTIO="",ZTRTN="DFNLOOP^DG944PST",ZTDTH=$H
S ZTDESC="DG*5.3*944 post-install cleanup of patient names with lowercase letters and missing FULL ICNs"
D ^%ZTLOAD
I '$G(ZTSK) D MES^XPDUTL(" **** Queuing job failed!!!") Q
D MES^XPDUTL(" Job number #"_ZTSK_" was queued.")
Q
;
DFNLOOP ; entry point for queued job to loop on Patient file
N DFNCNT,DFN,LCCNT,FICNT,NM,START,DONE,CKSUM,MPINODE,FULLICN,ICN,QUIT
S START=$$FMTE^XLFDT($$NOW^XLFDT)
S (DFNCNT,DFN,LCCNT,FICNT)=0
F S DFN=$O(^DPT(DFN)) Q:'DFN S DFNCNT=DFNCNT+1 D
.I $D(^DPT(DFN,-9)) Q
.S NM=$P($G(^DPT(DFN,0)),"^") I NM]"" I NM'["MERGING" I NM'?.UPN S LCCNT=LCCNT+1 D UPDNM
.D FULLCHK
S DONE=$$FMTE^XLFDT($$NOW^XLFDT)
;
EMAILS ; Send email to person who ran the INIT, letting them know results
N XMDUZ,XMTEXT,XMSUB,XMY,XMZ,XMDUN,X,R
S R(1)="Cleanup of patient names containing lowercase letters and missing FULL ICNs:"
S R(2)=" "
S R(3)="Process started: "_START
S R(4)="Process completed: "_DONE
S R(5)="Total number of patient names converted to uppercase: "_LCCNT
S R(6)="Total number of records updated with FULL ICN: "_FICNT
S R(7)=" ",R(8)="You can now delete the post-init routine ^DG944PST."
S XMTEXT="R(",XMSUB="Results from running patch DG*5.3*944"
S XMDUZ=.5
S XMY(DUZ)=""
D ^XMD
;
; Send message to MPI developers on Outlook
; IA#4440 supported call to check for test or production account
Q:$$PROD^XUPROD()=0 ;not a production account. Don't send email to MPI dev
;
N DGSNAME,DGSITE,XMDUZ,XMTEXT,XMSUB,XMY,XMZ,XMDUN,R
S X=$$SITE^VASITE()
S DGSNAME=$P(X,"^",2),DGSITE=$P(X,"^",3)
S R(1)="Post-Init routine ^DG944PST run at station: "_DGSITE_" - "_DGSNAME
S R(2)=" "
S R(3)="Process Started: "_START_" - Completed: "_DONE
S R(4)=" "
S R(5)="Total Patient file records processed: "_DFNCNT
S R(6)=" "
S R(7)="Total names converted to uppercase: "_LCCNT
S R(8)=" "
S R(9)="Total number of records updated with FULL ICN: "_FICNT
S XMTEXT="R(",XMSUB="Results from running patch DG*5.3*944 at station: "_DGSITE
S XMDUZ=DUZ
S XMY("Christine.Chesney@domain.ext")=""
S XMY("John.Williams30ec0c@domain.ext")=""
S XMY("Christine.Link@domain.ext")=""
D ^XMD
Q
;
UPDNM ; convert lowercase letters to uppercase letters and edit .01 in Patient file
N NEWNM,CHK
S CHK=NM,NEWNM=$TR(CHK,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
L +^DPT(DFN):10 I '$T Q
S DIE="^DPT(",DA=DFN,DR=".01///^S X=NEWNM"
D ^DIE K DIE,DA,DR
L -^DPT(DFN)
Q
;
FULLCHK ; check and populate FULL ICN field if needed
Q:'$D(^DPT(DFN,"MPI"))
S MPINODE=$G(^DPT(DFN,"MPI"))
S ICN=$P(MPINODE,"^"),CKSUM=$P(MPINODE,"^",2),FULLICN=$P(MPINODE,"^",10)
Q:FULLICN]""
I ICN,CKSUM D
. S FULLICN=ICN_"V"_CKSUM
. S DIE="^DPT(",DA=DFN,DR="991.1///^S X=FULLICN" D ^DIE S FICNT=FICNT+1
Q
;
BRFILE ; populate business rules into new file. To ensure this is only done once, check the
; file to make sure there are no entries in it already just in case the patch is re-installed.
; This way if there are changes broadcast from the MPI, they are not overwritten.
D MES^XPDUTL("Filed Business Rules for Source of Notifications to Document Types.")
N DGCOUNT,DGLINE,DGDATA,DGTIEN
S DGCOUNT=0
I $P($G(^DG(47.761,0)),"^",4) D Q
. D MES^XPDUTL("SOURCE OF NOTIFICATION BUSINESS RULES (#47.761) file already populated.")
F DGLINE=2:1 S DGDATA=$P($T(BRDATA+DGLINE),";",3) Q:DGDATA="" D
. N DGFDA,DGTYPE,DGIEN,DGROOT
. S DGTYPE=$O(^DG(47.75,"C",$P(DGDATA,"^",2),0))
. I 'DGTYPE D MES^XPDUTL("Document Type "_$P(DGDATA,"^",2)_" NOT FOUND!!") Q
. S DGIEN=+DGDATA
. I '$D(^DG(47.761,DGIEN)) D
.. N DGFDA
.. S DGFDA(1,47.761,"+1,",.01)=DGIEN
.. S DGFDA(1,47.761,"+1,",.02)=1
.. S DGFDA(1,47.761,"+1,",.03)=DT
.. S DGIEN(1)=DGIEN
.. D UPDATE^DIE("","DGFDA(1)","DGIEN","DGROOT")
. I $D(DGROOT) D MES^XPDUTL("ERROR filing Source "_DGDATA_$G(DGROOT("DIERR",1,"TEXT",1))) Q
. S DGFDA(1,47.7611,"+1,"_DGIEN_",",.01)=DGTYPE
. S DGFDA(1,47.7611,"+1,"_DGIEN_",",.02)=1
. S DGTIEN(1)=DGTYPE
. D UPDATE^DIE("","DGFDA(1)","DGTIEN","DGROOT")
. I $D(DGROOT) D MES^XPDUTL("ERROR filing Doc Type "_DGDATA_".") Q
. S DGCOUNT=DGCOUNT+1
D MES^XPDUTL("Filed Business Rules for "_DGCOUNT_" of 15 successfully.")
Q
;
BRDATA ; data to populate into the 47.761 file
; Format: Source of Notification^Document Type
;;1^INPTD
;;8^DC
;;8^SPROD
;;8^CR
;;8^DCUSG
;;8^CSUSG
;;8^ORUS
;;8^NDUCROD
;;8^NDPRA
;;8^NDCEOR
;;8^NODAP
;;8^NODOF
;;8^NODOFAF
;;8^UACCM
;;10^EC
;;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG944PST 8188 printed Sep 23, 2025@20:16:46 Page 2
DG944PST ;BIR/CML-PATCH DG*5.3*944 POST INSTALLATION ROUTINE ;5/1/17
+1 ;;5.3;Registration;**944**;Aug 13, 1993;Build 2
+2 ;
+3 ; - Story 500994 (cml)
+4 ; This post-init will loop thru the Patient file (^DPT(DFN)) and check the zero node looking for any names
+5 ; that contain lowercase letters.
+6 ; Any that are found will be updated to all uppercase and saved into the .01 field of the PATIENT (#2) file.
+7 ; When the job is complete it will send an email to:
+8 ; - (locally) POSTMASTER and the person who installed the patch (DUZ)
+9 ; - (MPI Outlook) Christine.Chesney@domain.ext, Link.Christine@domain.ext and John.Williams30ec0c@domain.ext.
+10 ;
+11 ; - Story 557843 (cml)
+12 ; This post-init will loop thru the Patient file (^DPT(DFN)) and check for any records that have an ICN and
+13 ; an ICN CHECKSUM but do NOT have the FULL ICN field populated.
+14 ; Any that are found will have the FULL ICN field updated to be ICN_"V"_CHECKSUM.
+15 ; When the job is complete it will send an email to:
+16 ; - (locally) POSTMASTER and the person who installed the patch (DUZ)
+17 ; - (MPI Outlook) Christine.Chesney@domain.ext, Link.Christine@domain.ext and John.Williams30ec0c@domain.ext.
+18 ;
+19 ; - Story 557808 (jfw)
+20 ; Add 'Department of Defense' entry to the SOURCE OF NOTIFICATION File (#47.76).
+21 ;
+22 ; - Story 557909 (jfw)
+23 ; Enable auditing on the PLACE OF BIRTH CITY (.092)/STATE (.093) fields
+24 ; in the PATIENT file (#2).
+25 ;
+26 ; - Stories 557815 and 557804 (elz)
+27 ; Populate the new Source of Notification Business Rules (#47.761) file with initial
+28 ; business rules for both Source of Notification and Document Types allowed
+29 ;
+30 ;
POST ;queue off post-init to identify and cleanup any names with lowercase characters or missing FULL ICN
+1 NEW DGI,DGFLDS
+2 ; Modifying the following field(s) in the PATIENT File #2:
+3 ; - .092 PLACE OF BIRTH [CITY]
+4 ; - .093 PLACE OF BIRTH [STATE]
+5 SET DGFLDS=".092,.093"
+6 DO BMES^XPDUTL("Post-Install:")
DO MES^XPDUTL("")
+7 ;Turning on AUDITING for PATIENT File field(s)
+8 FOR DGI=1:1:$LENGTH(DGFLDS,",")
DO AUDIT(2,$PIECE(DGFLDS,",",DGI),"PATIENT")
+9 ;Add new Source of Notification
DO UPDTFLE
+10 ;Add the DOD Source/Document type business rules into the new file
DO BRFILE
+11 ;Task off cleanup of lowercase letters in names or missing FULL ICN
DO QUE
+12 DO BMES^XPDUTL("Post-Install: Finished")
+13 QUIT
+14 ;
AUDIT(DGFILE,DGFLD,DGFNAME) ;Turn on Auditing for Field in File
+1 ;DBIA #4397 Supported
DO TURNON^DIAUTL(DGFILE,DGFLD)
+2 DO MES^XPDUTL(" Enabled AUDIT on file #"_DGFILE_" ("_DGFNAME_"), field #"_DGFLD)
+3 QUIT
+4 ;
UPDTFLE ;Create a new entry in SOURCE OF NOTIFICATIONS file (#47.76)
+1 NEW DGFDA,DGERRMSG
+2 DO BMES^XPDUTL(" Add A New Source Of Notification (Department of Defense) to File #47.76.")
+3 IF $$FIND1^DIC(47.76,"","X","Department of Defense")
DO MES^XPDUTL(" *** 'Department of Defense' Source of Notification entry already exists!")
QUIT
+4 SET DGFDA(47.76,"+1,",.01)="Department of Defense"
+5 SET DGFDA(47.76,"+1,",1)=14
+6 SET DGFDA(47.76,"+1,",2)=1
+7 DO UPDATE^DIE("","DGFDA","","DGERRMSG")
+8 IF $DATA(DGERRMSG)
DO MES^XPDUTL(" >>> ERROR! 'Department of Defense' Source of Notification NOT added!")
DO MES^XPDUTL(" [#"_DGERRMSG("DIERR",1)_": "_DGERRMSG("DIERR",1,"TEXT",1)_"]")
QUIT
+9 DO MES^XPDUTL(" *** 'Department of Defense' Source of Notification successfully added to")
+10 DO MES^XPDUTL(" File #47.76!")
+11 QUIT
+12 ;
QUE ; Queue off the cleanup of names with lowercase letters and missing FULL ICNs
+1 DO BMES^XPDUTL(" Queuing job to clean up lowercase names and missing FULL ICNs.")
+2 NEW ZTIO,ZTSK,ZTRTN,ZTDESC,ZTSAVE,ZTDTH,Y
+3 SET ZTIO=""
SET ZTRTN="DFNLOOP^DG944PST"
SET ZTDTH=$HOROLOG
+4 SET ZTDESC="DG*5.3*944 post-install cleanup of patient names with lowercase letters and missing FULL ICNs"
+5 DO ^%ZTLOAD
+6 IF '$GET(ZTSK)
DO MES^XPDUTL(" **** Queuing job failed!!!")
QUIT
+7 DO MES^XPDUTL(" Job number #"_ZTSK_" was queued.")
+8 QUIT
+9 ;
DFNLOOP ; entry point for queued job to loop on Patient file
+1 NEW DFNCNT,DFN,LCCNT,FICNT,NM,START,DONE,CKSUM,MPINODE,FULLICN,ICN,QUIT
+2 SET START=$$FMTE^XLFDT($$NOW^XLFDT)
+3 SET (DFNCNT,DFN,LCCNT,FICNT)=0
+4 FOR
SET DFN=$ORDER(^DPT(DFN))
if 'DFN
QUIT
SET DFNCNT=DFNCNT+1
Begin DoDot:1
+5 IF $DATA(^DPT(DFN,-9))
QUIT
+6 SET NM=$PIECE($GET(^DPT(DFN,0)),"^")
IF NM]""
IF NM'["MERGING"
IF NM'?.UPN
SET LCCNT=LCCNT+1
DO UPDNM
+7 DO FULLCHK
End DoDot:1
+8 SET DONE=$$FMTE^XLFDT($$NOW^XLFDT)
+9 ;
EMAILS ; Send email to person who ran the INIT, letting them know results
+1 NEW XMDUZ,XMTEXT,XMSUB,XMY,XMZ,XMDUN,X,R
+2 SET R(1)="Cleanup of patient names containing lowercase letters and missing FULL ICNs:"
+3 SET R(2)=" "
+4 SET R(3)="Process started: "_START
+5 SET R(4)="Process completed: "_DONE
+6 SET R(5)="Total number of patient names converted to uppercase: "_LCCNT
+7 SET R(6)="Total number of records updated with FULL ICN: "_FICNT
+8 SET R(7)=" "
SET R(8)="You can now delete the post-init routine ^DG944PST."
+9 SET XMTEXT="R("
SET XMSUB="Results from running patch DG*5.3*944"
+10 SET XMDUZ=.5
+11 SET XMY(DUZ)=""
+12 DO ^XMD
+13 ;
+14 ; Send message to MPI developers on Outlook
+15 ; IA#4440 supported call to check for test or production account
+16 ;not a production account. Don't send email to MPI dev
if $$PROD^XUPROD()=0
QUIT
+17 ;
+18 NEW DGSNAME,DGSITE,XMDUZ,XMTEXT,XMSUB,XMY,XMZ,XMDUN,R
+19 SET X=$$SITE^VASITE()
+20 SET DGSNAME=$PIECE(X,"^",2)
SET DGSITE=$PIECE(X,"^",3)
+21 SET R(1)="Post-Init routine ^DG944PST run at station: "_DGSITE_" - "_DGSNAME
+22 SET R(2)=" "
+23 SET R(3)="Process Started: "_START_" - Completed: "_DONE
+24 SET R(4)=" "
+25 SET R(5)="Total Patient file records processed: "_DFNCNT
+26 SET R(6)=" "
+27 SET R(7)="Total names converted to uppercase: "_LCCNT
+28 SET R(8)=" "
+29 SET R(9)="Total number of records updated with FULL ICN: "_FICNT
+30 SET XMTEXT="R("
SET XMSUB="Results from running patch DG*5.3*944 at station: "_DGSITE
+31 SET XMDUZ=DUZ
+32 SET XMY("Christine.Chesney@domain.ext")=""
+33 SET XMY("John.Williams30ec0c@domain.ext")=""
+34 SET XMY("Christine.Link@domain.ext")=""
+35 DO ^XMD
+36 QUIT
+37 ;
UPDNM ; convert lowercase letters to uppercase letters and edit .01 in Patient file
+1 NEW NEWNM,CHK
+2 SET CHK=NM
SET NEWNM=$TRANSLATE(CHK,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+3 LOCK +^DPT(DFN):10
IF '$TEST
QUIT
+4 SET DIE="^DPT("
SET DA=DFN
SET DR=".01///^S X=NEWNM"
+5 DO ^DIE
KILL DIE,DA,DR
+6 LOCK -^DPT(DFN)
+7 QUIT
+8 ;
FULLCHK ; check and populate FULL ICN field if needed
+1 if '$DATA(^DPT(DFN,"MPI"))
QUIT
+2 SET MPINODE=$GET(^DPT(DFN,"MPI"))
+3 SET ICN=$PIECE(MPINODE,"^")
SET CKSUM=$PIECE(MPINODE,"^",2)
SET FULLICN=$PIECE(MPINODE,"^",10)
+4 if FULLICN]""
QUIT
+5 IF ICN
IF CKSUM
Begin DoDot:1
+6 SET FULLICN=ICN_"V"_CKSUM
+7 SET DIE="^DPT("
SET DA=DFN
SET DR="991.1///^S X=FULLICN"
DO ^DIE
SET FICNT=FICNT+1
End DoDot:1
+8 QUIT
+9 ;
BRFILE ; populate business rules into new file. To ensure this is only done once, check the
+1 ; file to make sure there are no entries in it already just in case the patch is re-installed.
+2 ; This way if there are changes broadcast from the MPI, they are not overwritten.
+3 DO MES^XPDUTL("Filed Business Rules for Source of Notifications to Document Types.")
+4 NEW DGCOUNT,DGLINE,DGDATA,DGTIEN
+5 SET DGCOUNT=0
+6 IF $PIECE($GET(^DG(47.761,0)),"^",4)
Begin DoDot:1
+7 DO MES^XPDUTL("SOURCE OF NOTIFICATION BUSINESS RULES (#47.761) file already populated.")
End DoDot:1
QUIT
+8 FOR DGLINE=2:1
SET DGDATA=$PIECE($TEXT(BRDATA+DGLINE),";",3)
if DGDATA=""
QUIT
Begin DoDot:1
+9 NEW DGFDA,DGTYPE,DGIEN,DGROOT
+10 SET DGTYPE=$ORDER(^DG(47.75,"C",$PIECE(DGDATA,"^",2),0))
+11 IF 'DGTYPE
DO MES^XPDUTL("Document Type "_$PIECE(DGDATA,"^",2)_" NOT FOUND!!")
QUIT
+12 SET DGIEN=+DGDATA
+13 IF '$DATA(^DG(47.761,DGIEN))
Begin DoDot:2
+14 NEW DGFDA
+15 SET DGFDA(1,47.761,"+1,",.01)=DGIEN
+16 SET DGFDA(1,47.761,"+1,",.02)=1
+17 SET DGFDA(1,47.761,"+1,",.03)=DT
+18 SET DGIEN(1)=DGIEN
+19 DO UPDATE^DIE("","DGFDA(1)","DGIEN","DGROOT")
End DoDot:2
+20 IF $DATA(DGROOT)
DO MES^XPDUTL("ERROR filing Source "_DGDATA_$GET(DGROOT("DIERR",1,"TEXT",1)))
QUIT
+21 SET DGFDA(1,47.7611,"+1,"_DGIEN_",",.01)=DGTYPE
+22 SET DGFDA(1,47.7611,"+1,"_DGIEN_",",.02)=1
+23 SET DGTIEN(1)=DGTYPE
+24 DO UPDATE^DIE("","DGFDA(1)","DGTIEN","DGROOT")
+25 IF $DATA(DGROOT)
DO MES^XPDUTL("ERROR filing Doc Type "_DGDATA_".")
QUIT
+26 SET DGCOUNT=DGCOUNT+1
End DoDot:1
+27 DO MES^XPDUTL("Filed Business Rules for "_DGCOUNT_" of 15 successfully.")
+28 QUIT
+29 ;
BRDATA ; data to populate into the 47.761 file
+1 ; Format: Source of Notification^Document Type
+2 ;;1^INPTD
+3 ;;8^DC
+4 ;;8^SPROD
+5 ;;8^CR
+6 ;;8^DCUSG
+7 ;;8^CSUSG
+8 ;;8^ORUS
+9 ;;8^NDUCROD
+10 ;;8^NDPRA
+11 ;;8^NDCEOR
+12 ;;8^NODAP
+13 ;;8^NODOF
+14 ;;8^NODOFAF
+15 ;;8^UACCM
+16 ;;10^EC
+17 ;;
