DG963PST ;BIR/JFW-PATCH DG*5.3*963 POST INSTALLATION ROUTINE ;4/26/18
;;5.3;Registration;**963**;Aug 13, 1993;Build 1
;
; - Story 718515 (jfw)
; Update the DESCRIPTION(s) in the SUPPORTING DOCUMENTATION TYPES
; (#47.75) File for the following entries:
; - UNDER VA AUSPICES
; - EVVE CERTIFICATION
; - EVVE FACT OF DEATH QUERY
;
; IA's:
; BMES^XPDUTL - Supported #10141
; MES^XPDUTL - Supported #10141
; WP^DIE - Supported #2053
;
POST ;Post Init process to modify File #47.75
D BMES^XPDUTL("Post-Install:")
D SUPPDOC ;Supporting Documentation Description Update
D BMES^XPDUTL("Post-Install: Finished")
Q
;
;Modify the DESCRIPTIONs for the following TYPE CODEs in the
;SUPPORTING DOCUMENTATION TYPES File (#47.75):
; - EC : EVVE CERTIFICATION
; - EFDQ : EVVE FACT OF DEATH QUERY
; - UVA : UNDER VA AUSPICES
SUPPDOC ;
N DGI,DGDOCODES,DGLOC,DGTCODE
S DGLOC="^TMP($J,""DESC"")"
D BMES^XPDUTL(" Updating DESCRIPTIONS in SUPPORTING DOCUMENTATION TYPES File (#47.75)")
D MES^XPDUTL("")
S DGDOCODES="EC,EFDQ,UVA"
F DGI=1:1:$L(DGDOCODES,",") D
.K @DGLOC
.S DGTCODE=$P(DGDOCODES,",",DGI)
.D GWPDATA(DGTCODE,$NA(@DGLOC)) ;Get Description Data
.D WPUPDT(47.75,50,$O(^DG(47.75,"C",DGTCODE,"")),DGLOC)
K @DGLOC
Q
;
;Retrieve the Word Processing Supporting Document Type
;Description for the specified type code entry.
; TYPE - Supporting Document Type Code
; DGLOC - Location to Store Type Data In
GWPDATA(DGTYPE,DGLOC) ;
N DGDATA,DGLINE,DGEXIT,DGNODE
S DGEXIT=0,DGNODE=1
F DGLINE=2:1 S DGDATA=$P($T(SDTDATA+DGLINE),";",3,$L($T(SDTDATA+DGLINE),";")) Q:(DGDATA=""!DGEXIT) D
.;Ignore entry if NOT passed TYPE, but set exit condition
.;if TYPE already processed to short circuit loop.
.I $P(DGDATA,"^")'=DGTYPE D Q
..S:($D(@DGLOC)) DGEXIT=1
.S @DGLOC@(DGNODE)=$P(DGDATA,"^",2),DGNODE=DGNODE+1
Q
;
;Update Word Processing (WP) field in File with Data
; DGFILE - File where Record resides to update (REQ)
; DGFLD - Field in File to update (REQ)
; RECNUM - Record Number in File to update (REQ)
; DATA - Location of WP DATA (REQ)
WPUPDT(DGFILE,DGFLD,RECNUM,DATA) ;
N DGERR
D WP^DIE(DGFILE,RECNUM_",",DGFLD,"K",DATA,"DGERR")
I ($D(DGERR)) D
.D MES^XPDUTL(" *** '"_$P(^DG(47.75,RECNUM,0),"^")_"' DESCRIPTION NOT updated.")
.D MES^XPDUTL(" !!! Execute POST-INSTALL again from command line (D POST^DG963PST)")
D:('$D(DGERR)) MES^XPDUTL(" *** '"_$P(^DG(47.75,RECNUM,0),"^")_"' DESCRIPTION updated.")
Q
;
SDTDATA ; Supporting Documentation Type Description Data Updates
; FORMAT: SUPPORTING DOCUMENT TYPE CODE ^ DOCUMENT DESCRIPTION
;;EC^Requires receipt of a successful identity match confirming a previously
;;EC^established Date of Death via the EVVE Death Certification Query.
;;EC^Retention of electronic or hard copy documentation of the death
;;EC^certification is required. (Currently available via the EVVE pilot
;;EC^program only)
;;EFDQ^Requires receipt of a successful identity match providing the confirmed
;;EFDQ^Date of Death via one of the three search functions available within EVVE
;;EFDQ^Fact of Death Query: 1) Insurance Regulatory Settlement Agreement, 2)
;;EFDQ^SSN Exact Match, 3) Custom. Retention of electronic or hard copy
;;EFDQ^documentation of the returned data is required. (Currently available via
;;EFDQ^the EVVE pilot program only)
;;UVA^Deaths under VA auspices include deaths where the VA receives a medical
;;UVA^record from a non-VA provider documenting a death that occurs while the
;;UVA^non-VA provider was furnishing authorized non-VA care; deaths occurring
;;UVA^in a contract nursing home (i.e., a nursing home under contract with the
;;UVA^VA to care for the individual); or deaths during a home visit when a VA
;;UVA^provider is present. Documentation of the death should be received from
;;UVA^the non-VA provider or VA provider and entered into the persons record.
;;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG963PST 4057 printed Apr 09, 2024@22:02:52 Page 2
DG963PST ;BIR/JFW-PATCH DG*5.3*963 POST INSTALLATION ROUTINE ;4/26/18
+1 ;;5.3;Registration;**963**;Aug 13, 1993;Build 1
+2 ;
+3 ; - Story 718515 (jfw)
+4 ; Update the DESCRIPTION(s) in the SUPPORTING DOCUMENTATION TYPES
+5 ; (#47.75) File for the following entries:
+6 ; - UNDER VA AUSPICES
+7 ; - EVVE CERTIFICATION
+8 ; - EVVE FACT OF DEATH QUERY
+9 ;
+10 ; IA's:
+11 ; BMES^XPDUTL - Supported #10141
+12 ; MES^XPDUTL - Supported #10141
+13 ; WP^DIE - Supported #2053
+14 ;
POST ;Post Init process to modify File #47.75
+1 DO BMES^XPDUTL("Post-Install:")
+2 ;Supporting Documentation Description Update
DO SUPPDOC
+3 DO BMES^XPDUTL("Post-Install: Finished")
+4 QUIT
+5 ;
+6 ;Modify the DESCRIPTIONs for the following TYPE CODEs in the
+7 ;SUPPORTING DOCUMENTATION TYPES File (#47.75):
+8 ; - EC : EVVE CERTIFICATION
+9 ; - EFDQ : EVVE FACT OF DEATH QUERY
+10 ; - UVA : UNDER VA AUSPICES
SUPPDOC ;
+1 NEW DGI,DGDOCODES,DGLOC,DGTCODE
+2 SET DGLOC="^TMP($J,""DESC"")"
+3 DO BMES^XPDUTL(" Updating DESCRIPTIONS in SUPPORTING DOCUMENTATION TYPES File (#47.75)")
+4 DO MES^XPDUTL("")
+5 SET DGDOCODES="EC,EFDQ,UVA"
+6 FOR DGI=1:1:$LENGTH(DGDOCODES,",")
Begin DoDot:1
+7 KILL @DGLOC
+8 SET DGTCODE=$PIECE(DGDOCODES,",",DGI)
+9 ;Get Description Data
DO GWPDATA(DGTCODE,$NAME(@DGLOC))
+10 DO WPUPDT(47.75,50,$ORDER(^DG(47.75,"C",DGTCODE,"")),DGLOC)
End DoDot:1
+11 KILL @DGLOC
+12 QUIT
+13 ;
+14 ;Retrieve the Word Processing Supporting Document Type
+15 ;Description for the specified type code entry.
+16 ; TYPE - Supporting Document Type Code
+17 ; DGLOC - Location to Store Type Data In
GWPDATA(DGTYPE,DGLOC) ;
+1 NEW DGDATA,DGLINE,DGEXIT,DGNODE
+2 SET DGEXIT=0
SET DGNODE=1
+3 FOR DGLINE=2:1
SET DGDATA=$PIECE($TEXT(SDTDATA+DGLINE),";",3,$LENGTH($TEXT(SDTDATA+DGLINE),";"))
if (DGDATA=""!DGEXIT)
QUIT
Begin DoDot:1
+4 ;Ignore entry if NOT passed TYPE, but set exit condition
+5 ;if TYPE already processed to short circuit loop.
+6 IF $PIECE(DGDATA,"^")'=DGTYPE
Begin DoDot:2
+7 if ($DATA(@DGLOC))
SET DGEXIT=1
End DoDot:2
QUIT
+8 SET @DGLOC@(DGNODE)=$PIECE(DGDATA,"^",2)
SET DGNODE=DGNODE+1
End DoDot:1
+9 QUIT
+10 ;
+11 ;Update Word Processing (WP) field in File with Data
+12 ; DGFILE - File where Record resides to update (REQ)
+13 ; DGFLD - Field in File to update (REQ)
+14 ; RECNUM - Record Number in File to update (REQ)
+15 ; DATA - Location of WP DATA (REQ)
WPUPDT(DGFILE,DGFLD,RECNUM,DATA) ;
+1 NEW DGERR
+2 DO WP^DIE(DGFILE,RECNUM_",",DGFLD,"K",DATA,"DGERR")
+3 IF ($DATA(DGERR))
Begin DoDot:1
+4 DO MES^XPDUTL(" *** '"_$PIECE(^DG(47.75,RECNUM,0),"^")_"' DESCRIPTION NOT updated.")
+5 DO MES^XPDUTL(" !!! Execute POST-INSTALL again from command line (D POST^DG963PST)")
End DoDot:1
+6 if ('$DATA(DGERR))
DO MES^XPDUTL(" *** '"_$PIECE(^DG(47.75,RECNUM,0),"^")_"' DESCRIPTION updated.")
+7 QUIT
+8 ;
SDTDATA ; Supporting Documentation Type Description Data Updates
+1 ; FORMAT: SUPPORTING DOCUMENT TYPE CODE ^ DOCUMENT DESCRIPTION
+2 ;;EC^Requires receipt of a successful identity match confirming a previously
+3 ;;EC^established Date of Death via the EVVE Death Certification Query.
+4 ;;EC^Retention of electronic or hard copy documentation of the death
+5 ;;EC^certification is required. (Currently available via the EVVE pilot
+6 ;;EC^program only)
+7 ;;EFDQ^Requires receipt of a successful identity match providing the confirmed
+8 ;;EFDQ^Date of Death via one of the three search functions available within EVVE
+9 ;;EFDQ^Fact of Death Query: 1) Insurance Regulatory Settlement Agreement, 2)
+10 ;;EFDQ^SSN Exact Match, 3) Custom. Retention of electronic or hard copy
+11 ;;EFDQ^documentation of the returned data is required. (Currently available via
+12 ;;EFDQ^the EVVE pilot program only)
+13 ;;UVA^Deaths under VA auspices include deaths where the VA receives a medical
+14 ;;UVA^record from a non-VA provider documenting a death that occurs while the
+15 ;;UVA^non-VA provider was furnishing authorized non-VA care; deaths occurring
+16 ;;UVA^in a contract nursing home (i.e., a nursing home under contract with the
+17 ;;UVA^VA to care for the individual); or deaths during a home visit when a VA
+18 ;;UVA^provider is present. Documentation of the death should be received from
+19 ;;UVA^the non-VA provider or VA provider and entered into the persons record.
+20 ;;
