DG53P524 ;ALB/TMD - Patch DG*5.3*524 Install Utility Routine ; 7/17/03 8:48am
;;5.3;Registration;**524**;AUG 13, 1993
;
;
ENV ;Main entry point for Environment check point.
;
S XPDABORT=""
D PROGCHK(.XPDABORT) ;checks programmer variables
I XPDABORT="" K XPDABORT
Q
;
;
PRE ;Main entry point for Pre-init items.
Q
;
;
POST ;Main entry point for Post-init items.
;
D POST1
D POST2
D POST3
Q
;
;
PROGCHK(XPDABORT) ;checks for necessary programmer variables
;
I '$G(DUZ)!($G(DUZ(0))'="@")!('$G(DT))!($G(U)'="^") D
.D BMES^XPDUTL("*****")
.D MES^XPDUTL("Your programming variables are not set up properly.")
.D MES^XPDUTL("Installation aborted.")
.D MES^XPDUTL("*****")
.S XPDABORT=2
Q
;
;
POST1 ;Change Brief Description (#20) for SPANISH AMERICAN (number 3) in PERIOD OF SERVICE file (#21).
;
N DGBDESC ;Brief Description
N DGPOS ;Period of Service
N DGPOSIEN ;Period of Service IEN in file #21
N DGFDA ;FDA for DBS call
N DGERR ;Error array for DBS call
;
S DGPOS="SPANISH AMERICAN"
S DGBDESC="(4/21/1898-7/4/1902)"
D BMES^XPDUTL("** Updating PERIOD OF SERVICE file (#21) with new BRIEF DESCRIPTION field (#20) value for "_DGPOS_".")
S DGPOSIEN=$$FIND1^DIC(21,"","MX",DGPOS,"","","DGERR") D
.I 'DGPOSIEN!$D(DGERR) Q
.S DGFDA(21,DGPOSIEN_",",20)=DGBDESC
.D FILE^DIE("ET","DGFDA","DGERR")
I $G(DGERR)'="" D BMES^XPDUTL("** Update of "_DGPOS_" Period of Service was NOT successful.") Q
D BMES^XPDUTL("** BRIEF DESCRIPTION for "_DGPOS_" Period of Service changed to "_DGBDESC_".")
;
Q
;
POST2 ; Change Input Transform for Claim Number field (#.313) in Patient file (#2) to disallow length>10 (pseudo SSNs)
;
N DGCODE ; Changed input transform
N DGINTP ; Input template name
N DGERR ; Error flag
N DMAX ; Maximum Routine Size
N DGFIRST ; First four pieces of DD node containing input transform
N X,Y
;
I '$D(^DD(2,.313,0)) D BMES^XPDUTL("** Unable to locate DD node to update input transform for CLAIM NUMBER field (#.313) of the PATIENT file (#2)") Q
S DGFIRST=$P(^DD(2,.313,0),U,1,4)
S DGCODE="S DFN=DA D EV^DGLOCK I $D(X) S L=$S($D(^DPT(DA,0)):$P(^(0),U,9),1:X) W:X?1""SS"".E "" "",L S:X?1""SS"".E X=L"
S DGCODE=DGCODE_" K:$L(X)>9 X Q:'$D(X) I X'=L K:$L(X)>8!($L(X)<7)!'(X?.N) X"
S ^DD(2,.313,0)=DGFIRST_"^"_DGCODE
D BMES^XPDUTL("** Input transform of the CLAIM NUMBER field (#.313) of the PATIENT file (#2) changed to:")
D BMES^XPDUTL(DGCODE)
; Recompile Input Templates
F DGINTP="DG LOAD EDIT SCREEN 7","DVBHINQ UPDATE" S Y=$O(^DIE("B",DGINTP,0)) S DGERR=0 D I DGERR D BMES^XPDUTL("** "_DGINTP_" input template could not be updated")
.I 'Y S DGERR=1 Q
.S X=$P($G(^DIE(Y,"ROU")),U,2) I X="" S DGERR=1 Q
.S DMAX=$$ROUSIZE^DILF D EN^DIEZ
Q
POST3 ;
;N DGHELP ;New help prompt text
;
I '$D(^DD(2,.313,3)) D BMES^XPDUTL("** Unable to locate DD node to update Help Prompt for CLAIM NUMBER field (#.313) of the PATIENT file (#2)") Q
S DGHELP="Enter this patient's claim number as 7-8 numerics or enter SS if the claim number is the same as his/her SSN. Pseudo SSNs are not allowed."
S ^DD(2,.313,3)=DGHELP
D BMES^XPDUTL("** Help Prompt text for the CLAIM NUMBER field (#.313) of the PATIENT file (#2) changed to: ")
D BMES^XPDUTL(DGHELP)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53P524 3326 printed Dec 13, 2024@02:39:45 Page 2
DG53P524 ;ALB/TMD - Patch DG*5.3*524 Install Utility Routine ; 7/17/03 8:48am
+1 ;;5.3;Registration;**524**;AUG 13, 1993
+2 ;
+3 ;
ENV ;Main entry point for Environment check point.
+1 ;
+2 SET XPDABORT=""
+3 ;checks programmer variables
DO PROGCHK(.XPDABORT)
+4 IF XPDABORT=""
KILL XPDABORT
+5 QUIT
+6 ;
+7 ;
PRE ;Main entry point for Pre-init items.
+1 QUIT
+2 ;
+3 ;
POST ;Main entry point for Post-init items.
+1 ;
+2 DO POST1
+3 DO POST2
+4 DO POST3
+5 QUIT
+6 ;
+7 ;
PROGCHK(XPDABORT) ;checks for necessary programmer variables
+1 ;
+2 IF '$GET(DUZ)!($GET(DUZ(0))'="@")!('$GET(DT))!($GET(U)'="^")
Begin DoDot:1
+3 DO BMES^XPDUTL("*****")
+4 DO MES^XPDUTL("Your programming variables are not set up properly.")
+5 DO MES^XPDUTL("Installation aborted.")
+6 DO MES^XPDUTL("*****")
+7 SET XPDABORT=2
End DoDot:1
+8 QUIT
+9 ;
+10 ;
POST1 ;Change Brief Description (#20) for SPANISH AMERICAN (number 3) in PERIOD OF SERVICE file (#21).
+1 ;
+2 ;Brief Description
NEW DGBDESC
+3 ;Period of Service
NEW DGPOS
+4 ;Period of Service IEN in file #21
NEW DGPOSIEN
+5 ;FDA for DBS call
NEW DGFDA
+6 ;Error array for DBS call
NEW DGERR
+7 ;
+8 SET DGPOS="SPANISH AMERICAN"
+9 SET DGBDESC="(4/21/1898-7/4/1902)"
+10 DO BMES^XPDUTL("** Updating PERIOD OF SERVICE file (#21) with new BRIEF DESCRIPTION field (#20) value for "_DGPOS_".")
+11 SET DGPOSIEN=$$FIND1^DIC(21,"","MX",DGPOS,"","","DGERR")
Begin DoDot:1
+12 IF 'DGPOSIEN!$DATA(DGERR)
QUIT
+13 SET DGFDA(21,DGPOSIEN_",",20)=DGBDESC
+14 DO FILE^DIE("ET","DGFDA","DGERR")
End DoDot:1
+15 IF $GET(DGERR)'=""
DO BMES^XPDUTL("** Update of "_DGPOS_" Period of Service was NOT successful.")
QUIT
+16 DO BMES^XPDUTL("** BRIEF DESCRIPTION for "_DGPOS_" Period of Service changed to "_DGBDESC_".")
+17 ;
+18 QUIT
+19 ;
POST2 ; Change Input Transform for Claim Number field (#.313) in Patient file (#2) to disallow length>10 (pseudo SSNs)
+1 ;
+2 ; Changed input transform
NEW DGCODE
+3 ; Input template name
NEW DGINTP
+4 ; Error flag
NEW DGERR
+5 ; Maximum Routine Size
NEW DMAX
+6 ; First four pieces of DD node containing input transform
NEW DGFIRST
+7 NEW X,Y
+8 ;
+9 IF '$DATA(^DD(2,.313,0))
DO BMES^XPDUTL("** Unable to locate DD node to update input transform for CLAIM NUMBER field (#.313) of the PATIENT file (#2)")
QUIT
+10 SET DGFIRST=$PIECE(^DD(2,.313,0),U,1,4)
+11 SET DGCODE="S DFN=DA D EV^DGLOCK I $D(X) S L=$S($D(^DPT(DA,0)):$P(^(0),U,9),1:X) W:X?1""SS"".E "" "",L S:X?1""SS"".E X=L"
+12 SET DGCODE=DGCODE_" K:$L(X)>9 X Q:'$D(X) I X'=L K:$L(X)>8!($L(X)<7)!'(X?.N) X"
+13 SET ^DD(2,.313,0)=DGFIRST_"^"_DGCODE
+14 DO BMES^XPDUTL("** Input transform of the CLAIM NUMBER field (#.313) of the PATIENT file (#2) changed to:")
+15 DO BMES^XPDUTL(DGCODE)
+16 ; Recompile Input Templates
+17 FOR DGINTP="DG LOAD EDIT SCREEN 7","DVBHINQ UPDATE"
SET Y=$ORDER(^DIE("B",DGINTP,0))
SET DGERR=0
Begin DoDot:1
+18 IF 'Y
SET DGERR=1
QUIT
+19 SET X=$PIECE($GET(^DIE(Y,"ROU")),U,2)
IF X=""
SET DGERR=1
QUIT
+20 SET DMAX=$$ROUSIZE^DILF
DO EN^DIEZ
End DoDot:1
IF DGERR
DO BMES^XPDUTL("** "_DGINTP_" input template could not be updated")
+21 QUIT
POST3 ;
+1 ;N DGHELP ;New help prompt text
+2 ;
+3 IF '$DATA(^DD(2,.313,3))
DO BMES^XPDUTL("** Unable to locate DD node to update Help Prompt for CLAIM NUMBER field (#.313) of the PATIENT file (#2)")
QUIT
+4 SET DGHELP="Enter this patient's claim number as 7-8 numerics or enter SS if the claim number is the same as his/her SSN. Pseudo SSNs are not allowed."
+5 SET ^DD(2,.313,3)=DGHELP
+6 DO BMES^XPDUTL("** Help Prompt text for the CLAIM NUMBER field (#.313) of the PATIENT file (#2) changed to: ")
+7 DO BMES^XPDUTL(DGHELP)
+8 QUIT
+9 ;
