1 | GMRAY23 ;SLC/DAN Installation Utilities ;7/18/05 08:06
|
---|
2 | ;;4.0;Adverse Reaction Tracking;**23**;Mar 29, 1996
|
---|
3 | ;
|
---|
4 | ;DBIA SECTION
|
---|
5 | ;3744 - $$TESTPAT^VADPT
|
---|
6 | ;10061 - VADPT
|
---|
7 | ;2916 - DDMOD
|
---|
8 | ;10013 - DIK
|
---|
9 | ;2056 - DIQ
|
---|
10 | ;10018 - DIE
|
---|
11 | ;10070 - XMD
|
---|
12 | ;10103 - XLFDT
|
---|
13 | ;2051 - DIC
|
---|
14 | ;2232 - XUDHSET
|
---|
15 | ;
|
---|
16 | PRETRAN ;Load descriptions for files 120.82 and 120.83
|
---|
17 | M @XPDGREF@("GMRADD82")=^DIC(120.82,"%D")
|
---|
18 | M @XPDGREF@("GMRADD83")=^DIC(120.83,"%D")
|
---|
19 | Q
|
---|
20 | ;
|
---|
21 | GETERMS ;Make the request for the allergy standardized terms to be pushed to the site
|
---|
22 | N TMP,GMRADOM
|
---|
23 | S TMP=$$GETIEN^HDISVF09("ALLERGIES",.GMRADOM)
|
---|
24 | D EN^HDISVCMR(GMRADOM,"")
|
---|
25 | Q
|
---|
26 | ;
|
---|
27 | POST ;Post installation processes
|
---|
28 | N ERR,GMRADONT
|
---|
29 | D RESFILE
|
---|
30 | D RESDEV
|
---|
31 | D FIXREF
|
---|
32 | D ^GMRAY23A,^GMRAY23B,^GMRAY23C ;Set up new style xrefs
|
---|
33 | ;S GMRADONT=1 ;When GMRADONT is defined, messages are NOT sent to HDR
|
---|
34 | D CLN85
|
---|
35 | D FIXALG
|
---|
36 | D GETERMS
|
---|
37 | D MAIL
|
---|
38 | Q
|
---|
39 | ;
|
---|
40 | CLN85 ;Clean up erroneous date/times that are in the STOP DATE OF ADMINISTRATION field of CONCOMITANT DRUG multiple
|
---|
41 | N GMRAI,GMRAJ,ENDT
|
---|
42 | S GMRAI=0 F S GMRAI=$O(^GMR(120.85,GMRAI)) Q:'+GMRAI I $D(^GMR(120.85,GMRAI,13)) D
|
---|
43 | .S GMRAJ=0 F S GMRAJ=$O(^GMR(120.85,GMRAI,13,GMRAJ)) Q:'+GMRAJ D
|
---|
44 | ..S ENDT=$P($G(^GMR(120.85,GMRAI,13,GMRAJ,0)),U,3) Q:ENDT=""
|
---|
45 | ..I ENDT\1'=ENDT S $P(^GMR(120.85,GMRAI,13,GMRAJ,0),U,3)=ENDT\1 ;If value is date/time strip time
|
---|
46 | Q
|
---|
47 | ;
|
---|
48 | FIXALG ;Loop through 120.8, fix database issues
|
---|
49 | N GMRAI,FREE,REACTANT,ENTRY
|
---|
50 | S FREE=$O(^GMRD(120.82,"B","OTHER ALLERGY/ADVERSE REACTION",0)) S:'+FREE ERR=1 S:FREE FREE=FREE_";GMRD(120.82," Q:$G(ERR)
|
---|
51 | S GMRAI=0 F S GMRAI=$O(^GMR(120.8,GMRAI)) Q:'+GMRAI D
|
---|
52 | .I '$D(^GMR(120.8,GMRAI,0))!($L(^GMR(120.8,GMRAI,0),"^")=1) D DEL Q
|
---|
53 | .Q:$$TESTPAT^VADPT($P(^GMR(120.8,GMRAI,0),U)) ;stop if test patient
|
---|
54 | .I $D(^GMR(120.8,GMRAI,10)) D CHECKSS ;Check signs/symptoms for broken pointers
|
---|
55 | .D CHECK23(.DELETED) Q:$G(DELETED) ;If pieces 2 and 3 cannot be resolved, delete entry
|
---|
56 | Q
|
---|
57 | ;
|
---|
58 | DEL ;No zero node, remove entry
|
---|
59 | N DIK,DA
|
---|
60 | S DIK="^GMR(120.8,",DA=GMRAI
|
---|
61 | D ^DIK
|
---|
62 | Q
|
---|
63 | ;
|
---|
64 | CHECKSS ;Check Signs/Symptoms for broken pointers, delete if necessary
|
---|
65 | N GMRAJ,REF,DIK,DA,RIEN
|
---|
66 | S GMRAJ=0 F S GMRAJ=$O(^GMR(120.8,GMRAI,10,GMRAJ)) Q:'+GMRAJ D
|
---|
67 | .S REF=$P($G(^GMR(120.8,GMRAI,10,GMRAJ,0)),U) ;Pointer to 120.83
|
---|
68 | .I REF I $D(^GMRD(120.83,REF)) Q ;Pointer isn't broken - done
|
---|
69 | .S DA(1)=GMRAI,DA=GMRAJ,DIK="^GMR(120.8,DA(1),10," D ^DIK ;Remove S/S with broken pointer
|
---|
70 | .;If observed reaction then there should be a broken pointer in 120.85
|
---|
71 | .S RIEN=$O(^GMR(120.85,"C",GMRAI,0)) Q:'+RIEN
|
---|
72 | .S DA(1)=RIEN
|
---|
73 | .S DA=$O(^GMR(120.85,RIEN,2,"B",REF,0)) Q:'+DA ;S/S not found
|
---|
74 | .S DIK="^GMR(120.85,DA(1),2," D ^DIK ;Remove S/S from obs entry
|
---|
75 | Q
|
---|
76 | ;
|
---|
77 | CHECK23(DELETED) ;Check REACTANT (piece 2) and GMR ALLERGY (piece 3) to make sure they are present and valid
|
---|
78 | N REACTANT,ALLPTR,GMRA0,IEN,FILE,DIE,DA,DR,BROKEN
|
---|
79 | S DELETED=0
|
---|
80 | S GMRA0=$G(^GMR(120.8,GMRAI,0))
|
---|
81 | S REACTANT=$P(GMRA0,U,2)
|
---|
82 | S ALLPTR=$P(GMRA0,U,3)
|
---|
83 | S FILE=$P(ALLPTR,";",2)
|
---|
84 | S IEN=$P(ALLPTR,";")
|
---|
85 | S BROKEN=$S(ALLPTR="":1,FILE="":1,IEN="":1,1:$G(@("^"_FILE_IEN_",0)"))="")
|
---|
86 | I ALLPTR=""!(BROKEN) D Q ;If no pointer present or pointer is broken
|
---|
87 | .I REACTANT'="" S $P(^GMR(120.8,GMRAI,0),U,3)=FREE Q ;If REACTANT field has a value then set GMR ALLERGY to "free text" entry
|
---|
88 | .I REACTANT="" D DEL S DELETED=1 Q ;If no pointer or broken pointer and no value in REACTANT then delete entry
|
---|
89 | Q:DELETED
|
---|
90 | I ALLPTR'="",REACTANT="" D ;Pointer exists but no value in REACTANT field
|
---|
91 | .S FILE=+$P(@("^"_FILE_"0)"),U,2) ;Get file number
|
---|
92 | .S REACTANT=$$GET1^DIQ(FILE,IEN,$S(FILE'=50.67:.01,1:4))
|
---|
93 | .S DIE="^GMR(120.8,",DA=GMRAI,DR=".02////"_REACTANT D ^DIE
|
---|
94 | Q
|
---|
95 | ;
|
---|
96 | MAIL ;Send message indicating post install is finished
|
---|
97 | N XMSUB,XMTEXT,XMDUZ,XMY,XMZ,GMRATXT,CNT,VADM,DFN,REACTANT,LOOP,DIFROM
|
---|
98 | S XMDUZ="PATCH GMRA*4*23 POST-INSTALL",XMY(.5)="" S:$G(DUZ) XMY(DUZ)=""
|
---|
99 | S GMRATXT(1)="The post-install routine for patch GMRA*4*23"
|
---|
100 | S GMRATXT(2)="finished on "_$$FMTE^XLFDT($$NOW^XLFDT)_"."
|
---|
101 | S GMRATXT(3)=""
|
---|
102 | S CNT=3
|
---|
103 | I $G(ERR)=1 D
|
---|
104 | .S GMRATXT(4)="**NOTE: There was a problem with the installation!"
|
---|
105 | .S GMRATXT(5)="Required entry missing from file 120.82 - CONVERSION ABORTED.",GMRATXT(6)="Contact the National Help Desk for Immediate assistance."
|
---|
106 | S XMTEXT="GMRATXT(",XMSUB="PATCH GMRA*4*23 Post Install COMPLETED"
|
---|
107 | D ^XMD
|
---|
108 | Q
|
---|
109 | ;
|
---|
110 | RESFILE ;Restrict file access and update description
|
---|
111 | N FILE,J,GMRASEC
|
---|
112 | M ^DIC(120.82,"%D")=@XPDGREF@("GMRADD82")
|
---|
113 | M ^DIC(120.83,"%D")=@XPDGREF@("GMRADD83")
|
---|
114 | F J="DD","WR","DEL","LAYGO","AUDIT" S GMRASEC(J)="@"
|
---|
115 | F FILE=120.82,120.83 D
|
---|
116 | .S ^DD(FILE,.01,"LAYGO",1,0)="D:'$D(XUMF) EN^DDIOL(""Entries must be added via the Master File Server (MFS)."","""",""!?5,$C(7)"") I $D(XUMF)"
|
---|
117 | .S ^DD(FILE,.01,7.5)="I $G(DIC(0))[""L"",'$D(XUMF) K X D EN^DDIOL(""Entries must be edited via the Master File Server (MFS)."","""",""!?5,$C(7)"")"
|
---|
118 | .S ^DD(FILE,.01,"DEL",1,0)="D:'$D(XUMF) EN^DDIOL(""Entries must be inactivated via the Master File Server (MFS)."","""",""!?5,$C(7)"") I $D(XUMF)"
|
---|
119 | .D FILESEC^DDMOD(FILE,.GMRASEC) ;Force security update to file
|
---|
120 | F J=.01,1,2,99.98,99.99 S ^DD(120.82,J,9)="^",^DD(120.83,J,9)="^"
|
---|
121 | F J=120.821,120.831 S ^DD(J,.01,9)="^",^DD(J,.02,9)="^"
|
---|
122 | F J=120.823,120.824,120.8205 S ^DD(J,.01,9)="^"
|
---|
123 | Q
|
---|
124 | ;
|
---|
125 | RESDEV ;Set up resource device
|
---|
126 | N X
|
---|
127 | S X=$$RES^XUDHSET("GMRA UPDATE RESOURCE",,1,"Allergy update control")
|
---|
128 | Q
|
---|
129 | ;
|
---|
130 | FIXREF ;Fix new style xrefs so they fire when using DIK to set xrefs for an entry in the file
|
---|
131 | N LCV,DIE,DR,DA
|
---|
132 | S LCV=0 F S LCV=$O(^DD("IX","IX","AHDR",LCV)) Q:'+LCV S DIE="^DD(""IX"",",DA=LCV,DR=".41///"_"R" D ^DIE
|
---|
133 | Q
|
---|