IBY718PO ;EDE/TPF - POST INSTALL ROUTINE FOR IB*2.0*718
;;2.0;INTEGRATED BILLING;**718**;;Build 73
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
PRETRAN ;EP - PRE-TRANSPORT ROUTINE
N IBIEN,IBRTN,IBFILENUM,IBFILENM,IBPOSITION
;
S IBFILENUM=399.1 ;MAKE A GENERIC PARAMETER SET
S IBFILENM=$P($G(^DIC(IBFILENUM,0)),U)
S IBPOSITION="!?((IOM/2)-($L(A)/2))"
D EN^DDIOL("Entering PRE-TRANSPORT routine.....","","!!"_IBPOSITION)
D EN^DDIOL("Pulling data from #"_IBFILENUM_" "_IBFILENM_" .....","",IBPOSITION)
;
S IBRTN=$P($T(+1)," ")
K ^TMP(IBRTN,$J)
K @XPDGREF@(XPDNM) ;XPDGREF = ^XTMP("XPDT",BUILD_IEN,"TEMP")
; XPDNM = "IB*2.0*718"
S IBIEN=0
F S IBIEN=$O(^DGCR(IBFILENUM,IBIEN)) Q:'IBIEN D
.Q:'$$IENSTOPULL(IBIEN) ;NOT IN THE LIST TO TRANSPORT
.D PULL(IBIEN)
;
D EN^DDIOL("PRE-TRANSPORT routine finished.....","",IBPOSITION)
Q
;
PULL(IBIEN) ;EP - SET TRANSPORT TEMP GLOBAL UP WITH ASSIGN. AUTH. OID ENTRIES
I '$D(^DGCR(IBFILENUM,IBIEN,0)) D Q
.D EN^DDIOL("Review TRANSPORT LIST IN IENSTOPULL^"_IBRTN_" Entry not found for "_IBIEN,"",IBPOSITION)
;
M @XPDGREF@(XPDNM,IBFILENUM,IBIEN)=^DGCR(IBFILENUM,IBIEN)
;
Q
;
IENSTOPULL(IEN) ;EP - TRANSPORT THESE ENTRIES
;
I $G(^DGCR(399.1,IEN,2))'="" Q 1
;
I (U_58_U_79_U_80_U_642_U_643_U_639_U_678_U_689_U)[(U_IEN_U) Q 1
I $$NUMRANGE(IEN,60,62) Q 1
I $$NUMRANGE(IEN,45,47) Q 1
I $$NUMRANGE(IEN,74,76) Q 1
I $$NUMRANGE(IEN,82,84) Q 1
I $$NUMRANGE(IEN,86,91) Q 1
I $$NUMRANGE(IEN,94,99) Q 1
I $$NUMRANGE(IEN,102,104) Q 1
I $$NUMRANGE(IEN,265,268) Q 1
I $$NUMRANGE(IEN,587,590) Q 1
I $$NUMRANGE(IEN,634,638) Q 1
Q 0
;
NUMRANGE(X,LOW,HIGH) ;EP - NUMBER RANGE CHECK
;RETURNS 1 IF X LIES WITHIN NUMBER RANGE
I (X=LOW!(X>LOW)),(X<HIGH!(X=HIGH)) Q 1
Q 0
;
;D POST^ZZTPFPRETRANS
POST ;EP - BRING DATA IN FROM PRE-TRANSPORT KIDS GLOBAL
;
N IBIEN,IBRTN,IBGLBROOT,IBFILENUM,IBPOSITION,IBFDA,LOCALIEN,LOCALIENS
N IBFLAGS,IBFIELD,IBWPROOT,IBWPERROR,IBEMAILIEN,IBMESSAGE,IBNAME01,IBCODE
;
S IBEMAILIEN=11 ;TEST WHETHER WE NEED TO SET THIS TO NUMERIC IN E=SEQUENCE AFTER MSG IN EMAIL API S MSG(9+1)
S IBPOSITION="!?((IOM/2)-($L(A)/2))"
D EN^DDIOL("*** Post install started ***",,IBPOSITION)
S IBMESSAGE($$INC(.IBEMAILIEN))="*** Post install started ***"
;
S IBRTN=$P($T(+1)," ")
;
;XPDGREF = ^XTMP("XPDI",INSTALL_IEN,"TEMP")
;XPDNM = "IB*2.0*718"
;
S IBFILENUM=$QS($Q(@XPDGREF),5)
S IBIEN=0
F S IBIEN=$O(@XPDGREF@(XPDNM,IBFILENUM,IBIEN)) Q:'IBIEN D
.S IBNAME01=$P($G(@XPDGREF@(XPDNM,IBFILENUM,IBIEN,0)),U) ;NAME
.S IBCODE=$P($G(@XPDGREF@(XPDNM,IBFILENUM,IBIEN,0)),U,2) ;CODE
.;
.S LOCALIEN=$$FINDLOCALIEN(IBNAME01,IBFILENUM,IBCODE,.IBMESSAGE) ;FIND THE LOCAL ENTRY IEN WE NEED TO MODIFY
.Q:'LOCALIEN ;IF NO DISTINCT IEN FOUND DO NOT TRY AND MODIFY
.;
.S LOCALIENS=LOCALIEN_","
.S IBFDA(IBFILENUM,LOCALIENS,.19)=$P($G(@XPDGREF@(XPDNM,IBFILENUM,IBIEN,0)),U,12) ;#.19 VALUE CODE AMOUNT
.S:$G(@XPDGREF@(XPDNM,IBFILENUM,IBIEN,2))'="" IBFDA(IBFILENUM,LOCALIENS,2)=$G(@XPDGREF@(XPDNM,IBFILENUM,IBIEN,2)) ;FIELD #2 VALUE CODE AMOUNT SCREEN
.;
.;WORD PROCESSING FIELD MUST BE DONE BY WP^DIE
.S IBFIELD=1
.S IBFLAGS=""
.K IBWPROOT
.M IBWPROOT=@XPDGREF@(XPDNM,IBFILENUM,IBIEN,1)
.K IBWPROOT(0)
.S IBWPROOT="IBWPROOT"
.;
.D WP^DIE(IBFILENUM,LOCALIENS,IBFIELD,IBFLAGS,"IBWPROOT","IBWPERROR") ;^DGCR(399.1,D0,1,D1,0)= (#.01) VALUE CODE HELP TEXT [1W]
.;
.I $D(IBWPERROR) D
..S IBMESSAGE($$INC(.IBEMAILIEN))="Problem modifying Word Processing routine for "_NAME01_" in file "_IBFILENUM
.;
.;NOW LETS DO THE REGULAR FIELDS
.D MOD(LOCALIEN,IBFILENUM,.IBFDA)
.K IBFDA
;
D CRRCTSPELL ;FIX ONE ENTRY WITH INCORRECT SPELLING
;
D EN^DDIOL("Finished modifying Entries to "_$G(IBFILENUM)_" File","",IBPOSITION)
;
D EMAIL(.IBMESSAGE)
;
D EN^DDIOL("*** Post install completed ***","",IBPOSITION)
;
Q
;
INC(COUNTER) ;EP - INCREMENT EMAIL COUNTER
S COUNTER=$G(COUNTER)+1
Q COUNTER
;
FINDLOCALIEN(NAME01,FILENUM,IBCODE,IBMESSAGE) ;FIND THE LOCAL IEN WE NEED TO MODIFY
N RETURN,ERROR,INDEX,LOCALIEN,MATCHIEN
S INDEX="M"
D FIND^DIC(FILENUM,"","","",NAME01,INDEX,,,,"RETURN","ERROR")
;
I $D(ERROR) D Q 0
.S IBMESSAGE($$INC(.IBEMAILIEN))=""
.S IBMESSAGE($$INC(.IBEMAILIEN))="Error when searching for "_NAME01_" in file "_FILENUM_"!"
.S IBMESSAGE($$INC(.IBEMAILIEN))=""
;
I '$D(RETURN) D Q 0
.S IBMESSAGE($$INC(.IBEMAILIEN))=""
.S IBMESSAGE($$INC(.IBEMAILIEN))="Entry "_NAME01_" in file "_FILENUM_" not found."
.S IBMESSAGE($$INC(.IBEMAILIEN))=""
;
I $P($G(RETURN("DILIST",0)),U)>1 D
.S IBMESSAGE($$INC(.IBEMAILIEN))=""
.S IBMESSAGE($$INC(.IBEMAILIEN))="Duplicate entries found for "_NAME01_" in file "_FILENUM
.S IBMESSAGE($$INC(.IBEMAILIEN))="Using CODE '"_$G(IBCODE)_"' to determine correct record to update."
.S IBMESSAGE($$INC(.IBEMAILIEN))=""
.;CHECK FIELD #.18 VALUE CODE 0^NODE P^11
.S MATCHIEN=$$MATCHCODE(.RETURN,IBCODE,.IBMESSAGE)
.S LOCALIEN=$P($G(RETURN("DILIST",2,MATCHIEN)),U)
;
;AT THIS POINT WE HAVE FOUND ONE ENTRY AND WE CAN MODIFY IT
S:$G(LOCALIEN)="" LOCALIEN=$P($G(RETURN("DILIST",2,1)),U)
Q LOCALIEN
;
;CAN THIS BE MORE EFFICIENT?
MATCHCODE(RETURN,IBCODE,IBMESSAGE) ;EP - RETURN LOCAL IEN MATCHING NAME AND CODE OF INCOMING VALUE CODE ENTRY
N IEN,MATCH
S MATCH=0
S IEN=0
F S IEN=$O(RETURN("DILIST","ID",IEN)) Q:'IEN D Q:$G(MATCH)
.I IBCODE=RETURN("DILIST","ID",IEN,.02) S MATCH=IEN
;
I 'MATCH D
.D EN^DDIOL("No distinct match for Value Code "_$G(IBCODE)_" when duplicate records found!")
.S IBMESSAGE($$INC(.IBEMAILIEN))=""
.S IBMESSAGE($$INC(.IBEMAILIEN))="No distinct match for Value Code "_$G(IBCODE)_" when duplicate records found!"
.S IBMESSAGE($$INC(.IBEMAILIEN))=""
Q MATCH
;
MOD(IEN,FILENUM,FDA) ;UPDATE FILE
N ERROR
D FILE^DIE("","FDA","ERROR")
;
I $D(ERROR) D
.D EN^DDIOL("An attempt to update entry "_IEN_" in file "_FILENUM_" failed!","",IBPOSITION)
.S IBMESSAGE($$INC(.IBEMAILIEN))=""
.S IBMESSAGE($$INC(.IBEMAILIEN))="An attempt to update entry "_IEN_" in file "_FILENUM_" failed!"
.S IBMESSAGE($$INC(.IBEMAILIEN))=""
;
Q
;
EMAIL(MESSAGE) ; Send an email message to MCCF Developer Team
N SITE,SUBJ,MSG,XMTO
D EN^DDIOL("Sending email notification to MCCF Developers ... ","",IBPOSITION)
S SITE=$$SITE^VASITE
S SUBJ="POST install report for Patch "_$G(XPDNM)_"v"_$G(XPDNM("TST"))_" at "_$G(SITE)
S SUBJ=$TR($E(SUBJ,1,65),U," ")
S MSG(1)="The following site:"
S MSG(2)=""
S MSG(3)=" Name: "_$P(SITE,U,2)
S MSG(4)=" Station#: "_$P(SITE,U,3)
S MSG(5)=" Domain: "_$G(^XMB("NETNAME"))
S MSG(6)=" Date/Time: "_$$FMTE^XLFDT($$NOW^XLFDT,"5ZPM")
S MSG(7)=""
S MSG(8)=""
S MSG(9)="This is a "_$S($$PROD^XUPROD(1):"PRODUCTION",1:"TEST")_" account."
S MSG(10)=""
M MSG=MESSAGE
;
S XMTO("Timothy.Frazier1@domain.ext")=""
S XMTO("William.Jutzi@domain.ext")=""
S XMTO("John.Smith5@domain.ext")=""
;
D SENDMSG^XMXAPI(DUZ,SUBJ,"MSG",.XMTO)
;
Q
;
CRRCTSPELL ;EP - FIX SPELLING OF 'LIFETIIME RESERVE DAYS' IN #399.1
N X,Y,IEN,DIE,DR,DA,DIC,DIR
S DIC="^DGCR(399.1,"
S X="LIFETIIME RESERVE DAYS"
D ^DIC
S IBMESSAGE($$INC(.IBEMAILIEN))=""
I Y<1 S IBMESSAGE($$INC(.IBEMAILIEN))="'LIFETIIME RESERVE DAYS' not found in #399.1! Spelling Correction not needed." Q
S DA=+Y
K X
S DIE=DIC
S DR=".01////LIFETIME RESERVE DAYS"
D ^DIE
S IBMESSAGE($$INC(.IBEMAILIEN))="Spelling corrected for LIFETIIME RESERVE DAYS entry in #399.1"
S IBMESSAGE($$INC(.IBEMAILIEN))=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBY718PO 7684 printed Dec 13, 2024@02:35:10 Page 2
IBY718PO ;EDE/TPF - POST INSTALL ROUTINE FOR IB*2.0*718
+1 ;;2.0;INTEGRATED BILLING;**718**;;Build 73
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
PRETRAN ;EP - PRE-TRANSPORT ROUTINE
+1 NEW IBIEN,IBRTN,IBFILENUM,IBFILENM,IBPOSITION
+2 ;
+3 ;MAKE A GENERIC PARAMETER SET
SET IBFILENUM=399.1
+4 SET IBFILENM=$PIECE($GET(^DIC(IBFILENUM,0)),U)
+5 SET IBPOSITION="!?((IOM/2)-($L(A)/2))"
+6 DO EN^DDIOL("Entering PRE-TRANSPORT routine.....","","!!"_IBPOSITION)
+7 DO EN^DDIOL("Pulling data from #"_IBFILENUM_" "_IBFILENM_" .....","",IBPOSITION)
+8 ;
+9 SET IBRTN=$PIECE($TEXT(+1)," ")
+10 KILL ^TMP(IBRTN,$JOB)
+11 ;XPDGREF = ^XTMP("XPDT",BUILD_IEN,"TEMP")
KILL @XPDGREF@(XPDNM)
+12 ; XPDNM = "IB*2.0*718"
+13 SET IBIEN=0
+14 FOR
SET IBIEN=$ORDER(^DGCR(IBFILENUM,IBIEN))
if 'IBIEN
QUIT
Begin DoDot:1
+15 ;NOT IN THE LIST TO TRANSPORT
if '$$IENSTOPULL(IBIEN)
QUIT
+16 DO PULL(IBIEN)
End DoDot:1
+17 ;
+18 DO EN^DDIOL("PRE-TRANSPORT routine finished.....","",IBPOSITION)
+19 QUIT
+20 ;
PULL(IBIEN) ;EP - SET TRANSPORT TEMP GLOBAL UP WITH ASSIGN. AUTH. OID ENTRIES
+1 IF '$DATA(^DGCR(IBFILENUM,IBIEN,0))
Begin DoDot:1
+2 DO EN^DDIOL("Review TRANSPORT LIST IN IENSTOPULL^"_IBRTN_" Entry not found for "_IBIEN,"",IBPOSITION)
End DoDot:1
QUIT
+3 ;
+4 MERGE @XPDGREF@(XPDNM,IBFILENUM,IBIEN)=^DGCR(IBFILENUM,IBIEN)
+5 ;
+6 QUIT
+7 ;
IENSTOPULL(IEN) ;EP - TRANSPORT THESE ENTRIES
+1 ;
+2 IF $GET(^DGCR(399.1,IEN,2))'=""
QUIT 1
+3 ;
+4 IF (U_58_U_79_U_80_U_642_U_643_U_639_U_678_U_689_U)[(U_IEN_U)
QUIT 1
+5 IF $$NUMRANGE(IEN,60,62)
QUIT 1
+6 IF $$NUMRANGE(IEN,45,47)
QUIT 1
+7 IF $$NUMRANGE(IEN,74,76)
QUIT 1
+8 IF $$NUMRANGE(IEN,82,84)
QUIT 1
+9 IF $$NUMRANGE(IEN,86,91)
QUIT 1
+10 IF $$NUMRANGE(IEN,94,99)
QUIT 1
+11 IF $$NUMRANGE(IEN,102,104)
QUIT 1
+12 IF $$NUMRANGE(IEN,265,268)
QUIT 1
+13 IF $$NUMRANGE(IEN,587,590)
QUIT 1
+14 IF $$NUMRANGE(IEN,634,638)
QUIT 1
+15 QUIT 0
+16 ;
NUMRANGE(X,LOW,HIGH) ;EP - NUMBER RANGE CHECK
+1 ;RETURNS 1 IF X LIES WITHIN NUMBER RANGE
+2 IF (X=LOW!(X>LOW))
IF (X<HIGH!(X=HIGH))
QUIT 1
+3 QUIT 0
+4 ;
+5 ;D POST^ZZTPFPRETRANS
POST ;EP - BRING DATA IN FROM PRE-TRANSPORT KIDS GLOBAL
+1 ;
+2 NEW IBIEN,IBRTN,IBGLBROOT,IBFILENUM,IBPOSITION,IBFDA,LOCALIEN,LOCALIENS
+3 NEW IBFLAGS,IBFIELD,IBWPROOT,IBWPERROR,IBEMAILIEN,IBMESSAGE,IBNAME01,IBCODE
+4 ;
+5 ;TEST WHETHER WE NEED TO SET THIS TO NUMERIC IN E=SEQUENCE AFTER MSG IN EMAIL API S MSG(9+1)
SET IBEMAILIEN=11
+6 SET IBPOSITION="!?((IOM/2)-($L(A)/2))"
+7 DO EN^DDIOL("*** Post install started ***",,IBPOSITION)
+8 SET IBMESSAGE($$INC(.IBEMAILIEN))="*** Post install started ***"
+9 ;
+10 SET IBRTN=$PIECE($TEXT(+1)," ")
+11 ;
+12 ;XPDGREF = ^XTMP("XPDI",INSTALL_IEN,"TEMP")
+13 ;XPDNM = "IB*2.0*718"
+14 ;
+15 SET IBFILENUM=$QSUBSCRIPT($QUERY(@XPDGREF),5)
+16 SET IBIEN=0
+17 FOR
SET IBIEN=$ORDER(@XPDGREF@(XPDNM,IBFILENUM,IBIEN))
if 'IBIEN
QUIT
Begin DoDot:1
+18 ;NAME
SET IBNAME01=$PIECE($GET(@XPDGREF@(XPDNM,IBFILENUM,IBIEN,0)),U)
+19 ;CODE
SET IBCODE=$PIECE($GET(@XPDGREF@(XPDNM,IBFILENUM,IBIEN,0)),U,2)
+20 ;
+21 ;FIND THE LOCAL ENTRY IEN WE NEED TO MODIFY
SET LOCALIEN=$$FINDLOCALIEN(IBNAME01,IBFILENUM,IBCODE,.IBMESSAGE)
+22 ;IF NO DISTINCT IEN FOUND DO NOT TRY AND MODIFY
if 'LOCALIEN
QUIT
+23 ;
+24 SET LOCALIENS=LOCALIEN_","
+25 ;#.19 VALUE CODE AMOUNT
SET IBFDA(IBFILENUM,LOCALIENS,.19)=$PIECE($GET(@XPDGREF@(XPDNM,IBFILENUM,IBIEN,0)),U,12)
+26 ;FIELD #2 VALUE CODE AMOUNT SCREEN
if $GET(@XPDGREF@(XPDNM,IBFILENUM,IBIEN,2))'=""
SET IBFDA(IBFILENUM,LOCALIENS,2)=$GET(@XPDGREF@(XPDNM,IBFILENUM,IBIEN,2))
+27 ;
+28 ;WORD PROCESSING FIELD MUST BE DONE BY WP^DIE
+29 SET IBFIELD=1
+30 SET IBFLAGS=""
+31 KILL IBWPROOT
+32 MERGE IBWPROOT=@XPDGREF@(XPDNM,IBFILENUM,IBIEN,1)
+33 KILL IBWPROOT(0)
+34 SET IBWPROOT="IBWPROOT"
+35 ;
+36 ;^DGCR(399.1,D0,1,D1,0)= (#.01) VALUE CODE HELP TEXT [1W]
DO WP^DIE(IBFILENUM,LOCALIENS,IBFIELD,IBFLAGS,"IBWPROOT","IBWPERROR")
+37 ;
+38 IF $DATA(IBWPERROR)
Begin DoDot:2
+39 SET IBMESSAGE($$INC(.IBEMAILIEN))="Problem modifying Word Processing routine for "_NAME01_" in file "_IBFILENUM
End DoDot:2
+40 ;
+41 ;NOW LETS DO THE REGULAR FIELDS
+42 DO MOD(LOCALIEN,IBFILENUM,.IBFDA)
+43 KILL IBFDA
End DoDot:1
+44 ;
+45 ;FIX ONE ENTRY WITH INCORRECT SPELLING
DO CRRCTSPELL
+46 ;
+47 DO EN^DDIOL("Finished modifying Entries to "_$GET(IBFILENUM)_" File","",IBPOSITION)
+48 ;
+49 DO EMAIL(.IBMESSAGE)
+50 ;
+51 DO EN^DDIOL("*** Post install completed ***","",IBPOSITION)
+52 ;
+53 QUIT
+54 ;
INC(COUNTER) ;EP - INCREMENT EMAIL COUNTER
+1 SET COUNTER=$GET(COUNTER)+1
+2 QUIT COUNTER
+3 ;
FINDLOCALIEN(NAME01,FILENUM,IBCODE,IBMESSAGE) ;FIND THE LOCAL IEN WE NEED TO MODIFY
+1 NEW RETURN,ERROR,INDEX,LOCALIEN,MATCHIEN
+2 SET INDEX="M"
+3 DO FIND^DIC(FILENUM,"","","",NAME01,INDEX,,,,"RETURN","ERROR")
+4 ;
+5 IF $DATA(ERROR)
Begin DoDot:1
+6 SET IBMESSAGE($$INC(.IBEMAILIEN))=""
+7 SET IBMESSAGE($$INC(.IBEMAILIEN))="Error when searching for "_NAME01_" in file "_FILENUM_"!"
+8 SET IBMESSAGE($$INC(.IBEMAILIEN))=""
End DoDot:1
QUIT 0
+9 ;
+10 IF '$DATA(RETURN)
Begin DoDot:1
+11 SET IBMESSAGE($$INC(.IBEMAILIEN))=""
+12 SET IBMESSAGE($$INC(.IBEMAILIEN))="Entry "_NAME01_" in file "_FILENUM_" not found."
+13 SET IBMESSAGE($$INC(.IBEMAILIEN))=""
End DoDot:1
QUIT 0
+14 ;
+15 IF $PIECE($GET(RETURN("DILIST",0)),U)>1
Begin DoDot:1
+16 SET IBMESSAGE($$INC(.IBEMAILIEN))=""
+17 SET IBMESSAGE($$INC(.IBEMAILIEN))="Duplicate entries found for "_NAME01_" in file "_FILENUM
+18 SET IBMESSAGE($$INC(.IBEMAILIEN))="Using CODE '"_$GET(IBCODE)_"' to determine correct record to update."
+19 SET IBMESSAGE($$INC(.IBEMAILIEN))=""
+20 ;CHECK FIELD #.18 VALUE CODE 0^NODE P^11
+21 SET MATCHIEN=$$MATCHCODE(.RETURN,IBCODE,.IBMESSAGE)
+22 SET LOCALIEN=$PIECE($GET(RETURN("DILIST",2,MATCHIEN)),U)
End DoDot:1
+23 ;
+24 ;AT THIS POINT WE HAVE FOUND ONE ENTRY AND WE CAN MODIFY IT
+25 if $GET(LOCALIEN)=""
SET LOCALIEN=$PIECE($GET(RETURN("DILIST",2,1)),U)
+26 QUIT LOCALIEN
+27 ;
+28 ;CAN THIS BE MORE EFFICIENT?
MATCHCODE(RETURN,IBCODE,IBMESSAGE) ;EP - RETURN LOCAL IEN MATCHING NAME AND CODE OF INCOMING VALUE CODE ENTRY
+1 NEW IEN,MATCH
+2 SET MATCH=0
+3 SET IEN=0
+4 FOR
SET IEN=$ORDER(RETURN("DILIST","ID",IEN))
if 'IEN
QUIT
Begin DoDot:1
+5 IF IBCODE=RETURN("DILIST","ID",IEN,.02)
SET MATCH=IEN
End DoDot:1
if $GET(MATCH)
QUIT
+6 ;
+7 IF 'MATCH
Begin DoDot:1
+8 DO EN^DDIOL("No distinct match for Value Code "_$GET(IBCODE)_" when duplicate records found!")
+9 SET IBMESSAGE($$INC(.IBEMAILIEN))=""
+10 SET IBMESSAGE($$INC(.IBEMAILIEN))="No distinct match for Value Code "_$GET(IBCODE)_" when duplicate records found!"
+11 SET IBMESSAGE($$INC(.IBEMAILIEN))=""
End DoDot:1
+12 QUIT MATCH
+13 ;
MOD(IEN,FILENUM,FDA) ;UPDATE FILE
+1 NEW ERROR
+2 DO FILE^DIE("","FDA","ERROR")
+3 ;
+4 IF $DATA(ERROR)
Begin DoDot:1
+5 DO EN^DDIOL("An attempt to update entry "_IEN_" in file "_FILENUM_" failed!","",IBPOSITION)
+6 SET IBMESSAGE($$INC(.IBEMAILIEN))=""
+7 SET IBMESSAGE($$INC(.IBEMAILIEN))="An attempt to update entry "_IEN_" in file "_FILENUM_" failed!"
+8 SET IBMESSAGE($$INC(.IBEMAILIEN))=""
End DoDot:1
+9 ;
+10 QUIT
+11 ;
EMAIL(MESSAGE) ; Send an email message to MCCF Developer Team
+1 NEW SITE,SUBJ,MSG,XMTO
+2 DO EN^DDIOL("Sending email notification to MCCF Developers ... ","",IBPOSITION)
+3 SET SITE=$$SITE^VASITE
+4 SET SUBJ="POST install report for Patch "_$GET(XPDNM)_"v"_$GET(XPDNM("TST"))_" at "_$GET(SITE)
+5 SET SUBJ=$TRANSLATE($EXTRACT(SUBJ,1,65),U," ")
+6 SET MSG(1)="The following site:"
+7 SET MSG(2)=""
+8 SET MSG(3)=" Name: "_$PIECE(SITE,U,2)
+9 SET MSG(4)=" Station#: "_$PIECE(SITE,U,3)
+10 SET MSG(5)=" Domain: "_$GET(^XMB("NETNAME"))
+11 SET MSG(6)=" Date/Time: "_$$FMTE^XLFDT($$NOW^XLFDT,"5ZPM")
+12 SET MSG(7)=""
+13 SET MSG(8)=""
+14 SET MSG(9)="This is a "_$SELECT($$PROD^XUPROD(1):"PRODUCTION",1:"TEST")_" account."
+15 SET MSG(10)=""
+16 MERGE MSG=MESSAGE
+17 ;
+18 SET XMTO("Timothy.Frazier1@domain.ext")=""
+19 SET XMTO("William.Jutzi@domain.ext")=""
+20 SET XMTO("John.Smith5@domain.ext")=""
+21 ;
+22 DO SENDMSG^XMXAPI(DUZ,SUBJ,"MSG",.XMTO)
+23 ;
+24 QUIT
+25 ;
CRRCTSPELL ;EP - FIX SPELLING OF 'LIFETIIME RESERVE DAYS' IN #399.1
+1 NEW X,Y,IEN,DIE,DR,DA,DIC,DIR
+2 SET DIC="^DGCR(399.1,"
+3 SET X="LIFETIIME RESERVE DAYS"
+4 DO ^DIC
+5 SET IBMESSAGE($$INC(.IBEMAILIEN))=""
+6 IF Y<1
SET IBMESSAGE($$INC(.IBEMAILIEN))="'LIFETIIME RESERVE DAYS' not found in #399.1! Spelling Correction not needed."
QUIT
+7 SET DA=+Y
+8 KILL X
+9 SET DIE=DIC
+10 SET DR=".01////LIFETIME RESERVE DAYS"
+11 DO ^DIE
+12 SET IBMESSAGE($$INC(.IBEMAILIEN))="Spelling corrected for LIFETIIME RESERVE DAYS entry in #399.1"
+13 SET IBMESSAGE($$INC(.IBEMAILIEN))=""
+14 QUIT
