source: FOIAVistA/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAY23.m@ 1607

Last change on this file since 1607 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 5.4 KB
Line 
1GMRAY23 ;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 ;
16PRETRAN ;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 ;
21GETERMS ;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 ;
27POST ;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 ;
40CLN85 ;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 ;
48FIXALG ;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 ;
58DEL ;No zero node, remove entry
59 N DIK,DA
60 S DIK="^GMR(120.8,",DA=GMRAI
61 D ^DIK
62 Q
63 ;
64CHECKSS ;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 ;
77CHECK23(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 ;
96MAIL ;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 ;
110RESFILE ;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 ;
125RESDEV ;Set up resource device
126 N X
127 S X=$$RES^XUDHSET("GMRA UPDATE RESOURCE",,1,"Allergy update control")
128 Q
129 ;
130FIXREF ;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
Note: See TracBrowser for help on using the repository browser.