source: WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAY21.m@ 699

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

initial load of WorldVistAEHR

File size: 4.8 KB
Line 
1GMRAY21 ;SLC/DAN Post-init for patch 21 ;12/23/04 12:17
2 ;;4.0;Adverse Reaction Tracking;**21**;Mar 29, 1996
3 ;
4 ;DBIA SECTION
5 ;10063 - %ZTLOAD
6 ;3744 - $$TESTPAT^VADPT
7 ;10013 - DIK
8 ;10103 - XLFDT
9 ;10070 - XMD
10 ;10141 - XPDUTL
11 ;
12PRE ;Pre-install converts IODINE to allergy type of drug
13 N DIE,DA,DR
14 S DIE="^GMRD(120.82,",DA=$O(^GMRD(120.82,"B","IODINE",0)),DR="1////D"
15 I DA D ^DIE
16 Q
17 ;
18Q ;Entry point to queue process during install
19 N ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSK
20 S ZTRTN="DQ^GMRAY21",ZTDESC="GMRA*4*21 POST INSTALL ROUTINE",ZTIO="",ZTDTH=$H
21 D ^%ZTLOAD I '$G(ZTSK) D BMES^XPDUTL("POST INSTALL NOT QUEUED - RUN DQ^GMRA21 AFTER INSTALL FINISHES") Q
22 D BMES^XPDUTL("Post-install queued as task # "_$G(ZTSK))
23 Q
24 ;
25DQ ;Dequeue
26 N PROB,GMRAIOD
27 D POST,IODINE,ADDB,MAIL
28 Q
29 ;
30POST ;Post-init entry point
31 N DA,GMRAI,GMRA0,LCV,DIK
32 ;Check assessment level in 120.86 and make sure it makes the patient's actual assessment level
33 S GMRAI=0 F S GMRAI=$O(^GMR(120.86,GMRAI)) Q:'+GMRAI I $P(^(GMRAI,0),U,2),$$NKASCR^GMRANKA(GMRAI) S DIK="^GMR(120.86,",DA=GMRAI D ^DIK ;Delete assessment if patient doesn't have allergies and assessment is set to "has allergies"
34 ;Find entries in 120.8 that are missing the reactant or are missing additional required data and take appropriate action.
35 S GMRAI=0 F S GMRAI=$O(^GMR(120.8,GMRAI)) Q:'+GMRAI D
36 .S GMRA0=$G(^GMR(120.8,GMRAI,0))
37 .I GMRA0=""!($L(GMRA0,"^")=1)!($P(GMRA0,"^",2,3)="^") S DIK="^GMR(120.8,",DA=GMRAI D ^DIK Q ;Delete entry if no zero node or only 1 piece on zero node or missing reactant data
38 .I $P(GMRA0,U,6)="o" D CHECKOBS
39 ;Check observed data to make sure it's matched to the right patient
40 S LCV=0 F S LCV=$O(^GMR(120.85,LCV)) Q:'+LCV D
41 .S GMRA0=$G(^GMR(120.85,LCV,0)) Q:GMRA0=""
42 .I $P(GMRA0,U,2)'=$P($G(^GMR(120.8,$P(GMRA0,U,15),0)),U) S DIK="^GMR(120.85,",DA=LCV D ^DIK
43 Q
44 ;
45 ;
46CHECKOBS ;Check observation data to make sure it's present and accurate
47 N J
48 Q:$D(^GMR(120.8,GMRAI,"ER"))!($$TESTPAT^VADPT($P(GMRA0,U)))!($$DECEASED^GMRAFX($P(GMRA0,U))) ;Stop if allergy entered in error, test patient or deceased patient
49 I $P(GMRA0,U,12)=1 D
50 .I '$D(^GMR(120.85,"C",GMRAI)) S PROB($P(GMRA0,U),GMRAI)="OBS" Q ;Marked as observed but no data
51 .S J=0 F S J=$O(^GMR(120.85,"C",GMRAI,J)) Q:'+J I '$O(^GMR(120.85,J,2,0)) S PROB($P(GMRA0,U),GMRAI)="SS" ;Has observed data but no sign/symptoms
52 Q
53 ;
54MAIL ;Send message indicating post install is finished
55 N XMSUB,XMTEXT,XMDUZ,XMY,XMZ,GMRATXT,DFN,PCNT,VADM,CNT,IEN
56 S XMDUZ="PATCH GMRA*4*21 POST-INSTALL",XMY(.5)="" S:$G(DUZ) XMY(DUZ)=""
57 S GMRATXT(1)="The post-install routine for patch GMRA*4*21"
58 S GMRATXT(2)="finished on "_$$FMTE^XLFDT($$NOW^XLFDT)_"."
59 S GMRATXT(3)=""
60 S CNT=3 I $D(PROB) D
61 .S CNT=CNT+1,GMRATXT(CNT)="The following patients have observed allergy entries that are"
62 .S CNT=CNT+1,GMRATXT(CNT)="signed off (accepted) but are missing required data. Please review each"
63 .S CNT=CNT+1,GMRATXT(CNT)="entry and update (if data is known), mark it as entered in error,"
64 .S CNT=CNT+1,GMRATXT(CNT)="or leave it alone."
65 .S CNT=CNT+1,GMRATXT(CNT)=""
66 .S PCNT=0
67 .F S PCNT=$O(PROB(PCNT)) Q:'+PCNT D
68 ..S DFN=PCNT D DEM^VADPT
69 ..S IEN=0 F S IEN=$O(PROB(PCNT,IEN)) Q:'+IEN D
70 ...S CNT=CNT+1
71 ...S GMRATXT(CNT)=VADM(1)_" "_VA("BID")_" "_$P(^GMR(120.8,IEN,0),U,2)_" missing "_$S(PROB(PCNT,IEN)="OBS":"observation date",1:"sign/symptoms")
72 ..S CNT=CNT+1,GMRATXT(CNT)=""
73 I $D(GMRAIOD) D
74 .S CNT=CNT+1,GMRATXT(CNT)=$$REPEAT^XLFSTR("*",75),CNT=CNT+1,GMRATXT(CNT)=""
75 .S CNT=CNT+1,GMRATXT(CNT)="The following patients have had their IODINE allergies updated.",CNT=CNT+1,GMRATXT(CNT)="You should review them for accuracy.",CNT=CNT+1,GMRATXT(CNT)=""
76 .S DFN=0 F S DFN=$O(GMRAIOD(DFN)) Q:'+DFN K VADM D DEM^VADPT S CNT=CNT+1,GMRATXT(CNT)=VADM(1)_" "_VA("BID")
77 S XMTEXT="GMRATXT(",XMSUB="PATCH GMRA*4*21 Post Install COMPLETED"
78 D ^XMD
79 Q
80 ;
81IODINE ;Find existing IODINE allergies and update them
82 N GMRAIODN,GMRAI,PAT,GMRAPA,GMRAAR
83 S GMRAIODN=$O(^GMRD(120.82,"B","IODINE",0)) Q:'+GMRAIODN ;No IODINE entry
84 S (GMRAAR,GMRAIODN)=GMRAIODN_";GMRD(120.82,"
85 S GMRAI=0 F S GMRAI=$O(^GMR(120.8,"C","IODINE",GMRAI)) Q:'+GMRAI D
86 .S PAT=$P($G(^GMR(120.8,GMRAI,0)),U) Q:'+PAT ;No patient
87 .Q:$P($G(^GMR(120.8,GMRAI,0)),U,3)'=GMRAIODN ;Not the one we're looking for
88 .Q:$D(^GMR(120.8,GMRAI,"ER"))!($$DECEASED^GMRAFX(PAT)) ;Stop if entered in error or patient has expired
89 .S GMRAPA=GMRAI
90 .S DIE="^GMR(120.8,",DA=GMRAPA,DR="3.1////D" D ^DIE ;Update allergy type to drug
91 .D DELMUL^GMRAFX3(2),DELMUL^GMRAFX3(3) ;Delete any existing ingredients and drug classes for this allergy
92 .D UPDATE^GMRAPES1 ;add ingredients and drug classes from IODINE entry
93 .S GMRAIOD(PAT)=""
94 .Q
95 Q
96 ;
97ADDB ;Add B xref to reactions multiple in 120.85
98 N IEN,DA,DIK
99 S IEN=0 F S IEN=$O(^GMR(120.85,IEN)) Q:'+IEN I $D(^GMR(120.85,IEN,2)) D
100 .S $P(^GMR(120.85,IEN,2,0),U,2)="120.8502P"
101 .S DA(1)=IEN,DIK="^GMR(120.85,DA(1),2," D IXALL^DIK
102 Q
Note: See TracBrowser for help on using the repository browser.