DG950PST ;OAK/ELZ-PATCH DG*5.3*950 POST INSTALLATION ROUTINE ;10/13/17
;;5.3;Registration;**950**;Aug 13, 1993;Build 4
;
; Story 603913: Add New DOD Documentation Type - VA Auspices (elz)
; - Add new entry in SUPPORTING DOCUMENTATION TYPES (#47.75)
; Under VA Auspices code: UVA
; - Add new entry in SOURCE OF NOTIFICATION BUSINESS RULES (#47.761)
; VistA source of notification is Spouse/NOK/Other Person with supporting
; documentation of Under VA Auspices and active
;
;
; Story 603929: Add New DOD Documentation Type - EVVE Fact of Death Query (elz)
; - Add new entry in SUPPORTING DOCUMENTATION TYPES (#47.75)
; EVVE Fact of Death Query code: EFDQ
; - Add new entry in SOURCE OF NOTIFICATION BUSINESS RULES (#47.761)
; VistA source of notification is EVVE QUERY with supporting documentation of EVVE
; Fact of Death Query and active
;
; Story 625205: Loop through Patient file (#2) and verify that the ICN (#991.01) and
; ICN CHECKSUM (#991.02) values match the FULL ICN (#991.1) value, if
; NOT then update the FULL ICN field with the ICN and ICN CHECKSUM values.
;
POST ;
D BMES^XPDUTL("Post-Install: Starting")
D UPDTFLE
D BRFILE
D QUE ;Task off validation of the FULL ICN values
D BMES^XPDUTL("Post-Install: Finished")
Q
;
UPDTFLE ;Create a new entries in SUPPORTING DOCUMENTATION TYPES (#47.75) file
N DGDOCTYP
D BMES^XPDUTL(" Adding new Supporting Document Types to File #47.75")
F DGDOCTYP="20^UNDER VA AUSPICES^UVA","21^EVVE FACT OF DEATH QUERY^EFDQ" D
. N DGFDA,DGERRMSG,DGIEN,DGTMP
. I $$FIND1^DIC(47.75,"","X",$P(DGDOCTYP,"^",2)) D MES^XPDUTL(" *** '"_$P(DGDOCTYP,"^",2)_"' Supporting Documentation Type already exists!") Q
. I $D(^DIC(47.75,+DGDOCTYP)) D MES^XPDUTL(" >>> ERROR! Entry #"_(+DGDOCTYP)_" for '"_$P(DGDOCTYP,"^",2)_"' already exists where it should not be") Q
. S DGFDA(47.75,"+1,",.01)=$P(DGDOCTYP,"^",2)
. S DGFDA(47.75,"+1,",1)=$P(DGDOCTYP,"^",3)
. S DGIEN(1)=+DGDOCTYP
. D UPDATE^DIE("","DGFDA","DGIEN","DGERRMSG")
. I $D(DGERRMSG) D MES^XPDUTL(" >>> ERROR! '"_$P(DGDOCTYP,"^",2)_"' Supporting Document Type NOT added!"),MES^XPDUTL(" [#"_DGERRMSG("DIERR",1)_": "_DGERRMSG("DIERR",1,"TEXT",1)_"]") Q
. ; Add name as description
. S DGIEN=+DGDOCTYP_",",DGTMP("WP",1,0)=$P(DGDOCTYP,"^",2)
. D WP^DIE(47.75,DGIEN,50,"K","DGTMP(""WP"")")
. D MES^XPDUTL(" *** '"_$P(DGDOCTYP,"^",2)_"' Supporting Document Type successfully added")
D BMES^XPDUTL(" Finished adding new Supporting Document Types to file #47.75")
Q
;
BRFILE ; populate business new rules into file. To ensure this is only done once, check the
; file to make sure they are not already just in case the patch is re-installed.
D MES^XPDUTL("Filed Business Rules for Source of Notifications to Document Types.")
N DGCOUNT,DGLINE,DGDATA,DGRTN
D MES^XPDUTL("Adding business rules for new Supporting Document Types to file #47.761")
S DGCOUNT=0
F DGLINE=2:1 S DGDATA=$P($T(BRDATA+DGLINE),";",3) Q:DGDATA="" S DGCOUNT=DGCOUNT+1,DGDATA(DGCOUNT)=DGDATA
D BRDATA^DGDTHBR(.DGRTN,.DGDATA)
I $G(DGRTN(1))>0 D MES^XPDUTL($P(DGRTN(1),"^")_" out of 2 successfully filed") Q
S DGLINE=0 F S DGLINE=$O(DGRTN(DGLINE)) Q:'DGLINE D MES^XPDUTL(DGRTN(DGLINE))
Q
;
BRDATA ; data to populate into the 47.761 file
; Format: IEN of Source of Notification^Active^Supporting Document Type (Type Code)^Active
;;8^1^UVA^1
;;10^1^EFDQ^1
;;
;
QUE ;Queue the validation of the FULL ICN (#991.1) against the ICN (#991.01) and ICN CHECKSUM (#991.02)
D BMES^XPDUTL(" Queuing job to validate the FULL ICNs.")
N ZTIO,ZTSK,ZTRTN,ZTDESC,ZTSAVE,ZTDTH,Y
S ZTIO="",ZTRTN="VFULLICN^DG950PST",ZTDTH=$H
S ZTDESC="DG*5.3*950 post-install validation of FULL ICNs"
D ^%ZTLOAD
I '$G(ZTSK) D MES^XPDUTL(" **** Queuing job failed!!!") Q
D MES^XPDUTL(" Job number #"_ZTSK_" was queued.")
Q
;
VFULLICN ;entry point for queued job to loop on Patient file to validate FULL ICN
N DFNCNT,DFN,FICNT,START,DONE,MPINODE,FULLICN,ICN,CKSUM,DGFDA,DGERRMSG
S START=$$FMTE^XLFDT($$NOW^XLFDT)
S (DFNCNT,DFN,FICNT)=0
F S DFN=$O(^DPT(DFN)) Q:'DFN S DFNCNT=DFNCNT+1 D
.Q:'$D(^DPT(DFN,"MPI"))
.S MPINODE=$G(^DPT(DFN,"MPI"))
.S ICN=$P(MPINODE,"^"),CKSUM=$P(MPINODE,"^",2),FULLICN=$P(MPINODE,"^",10)
.Q:(ICN="")
.I ($TR(FULLICN,"V","")'=(ICN_CKSUM)) D
..K DGFDA
..S FICNT=FICNT+1
..L +^DPT(DFN,"MPI"):10
..S DGFDA(2,DFN_",",991.1)=ICN_"V"_CKSUM D UPDATE^DIE("","DGFDA","","DGERRMSG")
..L -^DPT(DFN,"MPI")
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)="Validation of FULL ICN (#991.1) against the ICN (#991.01) and"
S R(2)=" ICN CHECKSUM (#991.02):"
S R(3)=" "
S R(4)="Process started: "_START
S R(5)="Process completed: "_DONE
S R(6)="Total number of records updated with a corrected FULL ICN: "_FICNT
S R(7)=" ",R(8)="You can now delete the post-init routine ^DG950PST."
S XMTEXT="R(",XMSUB="Results from running patch DG*5.3*950"
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 DG950PST 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 number of records updated with a corrected FULL ICN: "_FICNT
S XMTEXT="R(",XMSUB="Results from running patch DG*5.3*950 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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG950PST 6184 printed Apr 09, 2024@21:44:05 Page 2
DG950PST ;OAK/ELZ-PATCH DG*5.3*950 POST INSTALLATION ROUTINE ;10/13/17
+1 ;;5.3;Registration;**950**;Aug 13, 1993;Build 4
+2 ;
+3 ; Story 603913: Add New DOD Documentation Type - VA Auspices (elz)
+4 ; - Add new entry in SUPPORTING DOCUMENTATION TYPES (#47.75)
+5 ; Under VA Auspices code: UVA
+6 ; - Add new entry in SOURCE OF NOTIFICATION BUSINESS RULES (#47.761)
+7 ; VistA source of notification is Spouse/NOK/Other Person with supporting
+8 ; documentation of Under VA Auspices and active
+9 ;
+10 ;
+11 ; Story 603929: Add New DOD Documentation Type - EVVE Fact of Death Query (elz)
+12 ; - Add new entry in SUPPORTING DOCUMENTATION TYPES (#47.75)
+13 ; EVVE Fact of Death Query code: EFDQ
+14 ; - Add new entry in SOURCE OF NOTIFICATION BUSINESS RULES (#47.761)
+15 ; VistA source of notification is EVVE QUERY with supporting documentation of EVVE
+16 ; Fact of Death Query and active
+17 ;
+18 ; Story 625205: Loop through Patient file (#2) and verify that the ICN (#991.01) and
+19 ; ICN CHECKSUM (#991.02) values match the FULL ICN (#991.1) value, if
+20 ; NOT then update the FULL ICN field with the ICN and ICN CHECKSUM values.
+21 ;
POST ;
+1 DO BMES^XPDUTL("Post-Install: Starting")
+2 DO UPDTFLE
+3 DO BRFILE
+4 ;Task off validation of the FULL ICN values
DO QUE
+5 DO BMES^XPDUTL("Post-Install: Finished")
+6 QUIT
+7 ;
UPDTFLE ;Create a new entries in SUPPORTING DOCUMENTATION TYPES (#47.75) file
+1 NEW DGDOCTYP
+2 DO BMES^XPDUTL(" Adding new Supporting Document Types to File #47.75")
+3 FOR DGDOCTYP="20^UNDER VA AUSPICES^UVA","21^EVVE FACT OF DEATH QUERY^EFDQ"
Begin DoDot:1
+4 NEW DGFDA,DGERRMSG,DGIEN,DGTMP
+5 IF $$FIND1^DIC(47.75,"","X",$PIECE(DGDOCTYP,"^",2))
DO MES^XPDUTL(" *** '"_$PIECE(DGDOCTYP,"^",2)_"' Supporting Documentation Type already exists!")
QUIT
+6 IF $DATA(^DIC(47.75,+DGDOCTYP))
DO MES^XPDUTL(" >>> ERROR! Entry #"_(+DGDOCTYP)_" for '"_$PIECE(DGDOCTYP,"^",2)_"' already exists where it should not be")
QUIT
+7 SET DGFDA(47.75,"+1,",.01)=$PIECE(DGDOCTYP,"^",2)
+8 SET DGFDA(47.75,"+1,",1)=$PIECE(DGDOCTYP,"^",3)
+9 SET DGIEN(1)=+DGDOCTYP
+10 DO UPDATE^DIE("","DGFDA","DGIEN","DGERRMSG")
+11 IF $DATA(DGERRMSG)
DO MES^XPDUTL(" >>> ERROR! '"_$PIECE(DGDOCTYP,"^",2)_"' Supporting Document Type NOT added!")
DO MES^XPDUTL(" [#"_DGERRMSG("DIERR",1)_": "_DGERRMSG("DIERR",1,"TEXT",1)_"]")
QUIT
+12 ; Add name as description
+13 SET DGIEN=+DGDOCTYP_","
SET DGTMP("WP",1,0)=$PIECE(DGDOCTYP,"^",2)
+14 DO WP^DIE(47.75,DGIEN,50,"K","DGTMP(""WP"")")
+15 DO MES^XPDUTL(" *** '"_$PIECE(DGDOCTYP,"^",2)_"' Supporting Document Type successfully added")
End DoDot:1
+16 DO BMES^XPDUTL(" Finished adding new Supporting Document Types to file #47.75")
+17 QUIT
+18 ;
BRFILE ; populate business new rules into file. To ensure this is only done once, check the
+1 ; file to make sure they are not already just in case the patch is re-installed.
+2 DO MES^XPDUTL("Filed Business Rules for Source of Notifications to Document Types.")
+3 NEW DGCOUNT,DGLINE,DGDATA,DGRTN
+4 DO MES^XPDUTL("Adding business rules for new Supporting Document Types to file #47.761")
+5 SET DGCOUNT=0
+6 FOR DGLINE=2:1
SET DGDATA=$PIECE($TEXT(BRDATA+DGLINE),";",3)
if DGDATA=""
QUIT
SET DGCOUNT=DGCOUNT+1
SET DGDATA(DGCOUNT)=DGDATA
+7 DO BRDATA^DGDTHBR(.DGRTN,.DGDATA)
+8 IF $GET(DGRTN(1))>0
DO MES^XPDUTL($PIECE(DGRTN(1),"^")_" out of 2 successfully filed")
QUIT
+9 SET DGLINE=0
FOR
SET DGLINE=$ORDER(DGRTN(DGLINE))
if 'DGLINE
QUIT
DO MES^XPDUTL(DGRTN(DGLINE))
+10 QUIT
+11 ;
BRDATA ; data to populate into the 47.761 file
+1 ; Format: IEN of Source of Notification^Active^Supporting Document Type (Type Code)^Active
+2 ;;8^1^UVA^1
+3 ;;10^1^EFDQ^1
+4 ;;
+5 ;
QUE ;Queue the validation of the FULL ICN (#991.1) against the ICN (#991.01) and ICN CHECKSUM (#991.02)
+1 DO BMES^XPDUTL(" Queuing job to validate the FULL ICNs.")
+2 NEW ZTIO,ZTSK,ZTRTN,ZTDESC,ZTSAVE,ZTDTH,Y
+3 SET ZTIO=""
SET ZTRTN="VFULLICN^DG950PST"
SET ZTDTH=$HOROLOG
+4 SET ZTDESC="DG*5.3*950 post-install validation of 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 ;
VFULLICN ;entry point for queued job to loop on Patient file to validate FULL ICN
+1 NEW DFNCNT,DFN,FICNT,START,DONE,MPINODE,FULLICN,ICN,CKSUM,DGFDA,DGERRMSG
+2 SET START=$$FMTE^XLFDT($$NOW^XLFDT)
+3 SET (DFNCNT,DFN,FICNT)=0
+4 FOR
SET DFN=$ORDER(^DPT(DFN))
if 'DFN
QUIT
SET DFNCNT=DFNCNT+1
Begin DoDot:1
+5 if '$DATA(^DPT(DFN,"MPI"))
QUIT
+6 SET MPINODE=$GET(^DPT(DFN,"MPI"))
+7 SET ICN=$PIECE(MPINODE,"^")
SET CKSUM=$PIECE(MPINODE,"^",2)
SET FULLICN=$PIECE(MPINODE,"^",10)
+8 if (ICN="")
QUIT
+9 IF ($TRANSLATE(FULLICN,"V","")'=(ICN_CKSUM))
Begin DoDot:2
+10 KILL DGFDA
+11 SET FICNT=FICNT+1
+12 LOCK +^DPT(DFN,"MPI"):10
+13 SET DGFDA(2,DFN_",",991.1)=ICN_"V"_CKSUM
DO UPDATE^DIE("","DGFDA","","DGERRMSG")
+14 LOCK -^DPT(DFN,"MPI")
End DoDot:2
End DoDot:1
+15 SET DONE=$$FMTE^XLFDT($$NOW^XLFDT)
+16 ;
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)="Validation of FULL ICN (#991.1) against the ICN (#991.01) and"
+3 SET R(2)=" ICN CHECKSUM (#991.02):"
+4 SET R(3)=" "
+5 SET R(4)="Process started: "_START
+6 SET R(5)="Process completed: "_DONE
+7 SET R(6)="Total number of records updated with a corrected FULL ICN: "_FICNT
+8 SET R(7)=" "
SET R(8)="You can now delete the post-init routine ^DG950PST."
+9 SET XMTEXT="R("
SET XMSUB="Results from running patch DG*5.3*950"
+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 DG950PST 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 number of records updated with a corrected FULL ICN: "_FICNT
+28 SET XMTEXT="R("
SET XMSUB="Results from running patch DG*5.3*950 at station: "_DGSITE
+29 SET XMDUZ=DUZ
+30 SET XMY("Christine.Chesney@domain.ext")=""
+31 SET XMY("John.Williams30ec0c@domain.ext")=""
+32 SET XMY("Christine.Link@domain.ext")=""
+33 DO ^XMD
+34 QUIT
+35 ;
