source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMP6ID.m@ 1800

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

initial load of WorldVistAEHR
File size: 4.7 KB
Line 
1PXRMP6ID ; SLC/AGP - Inits for PXRM*2.0*6 ;11/25/2007
2 ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
3 ;
4 Q
5 ;====================================================
6BDICONV ;
7 N BDI,BDI2,DA,DIE,DR,ITEM,NAME,NLINES,RGBDI,RGBDI2,TEXT
8 K ^TMP("PXRMXMZ",$J)
9 S TEXT(1)="Converting Dialog Elements from BDI to BDI2."
10 S TEXT(2)="See Mailman message for more details."
11 D MES^XPDUTL(.TEXT)
12 S NLINES=1,TEXT="Dialog Elements names that were converted."
13 S ^TMP("PXRMXMZ",$J,NLINES,0)=TEXT
14 S DIE="^PXRMD(801.41,"
15 S BDI=$O(^YTT(601,"B","BDI","")) Q:BDI'>0
16 S BDI2=$O(^YTT(601,"B","BDI2","")) Q:BDI2'>0
17 S BDI=BDI_";YTT(601,",BDI2=BDI2_";YTT(601,"
18 S RGBDI=$O(^PXRMD(801.41,"B","PXRM BDI RESULT GROUP","")) Q:RGBDI'>0
19 S RGBDI2=$O(^PXRMD(801.41,"B","PXRM BDI II RESULT GROUP","")) Q:RGBDI2'>0
20 S DA=0 F S DA=$O(^PXRMD(801.41,DA)) Q:DA'>0 D
21 .S ITEM=$P($G(^PXRMD(801.41,DA,1)),U,5) Q:ITEM'>0
22 .I BDI=ITEM D
23 ..S NAME=$P($G(^PXRMD(801.41,DA,0)),U)
24 ..S DR="15////^S X=BDI2"
25 ..I $P($G(^PXRMD(801.41,DA,0)),U,15)=RGBDI D
26 ...S DR=DR_";55////^S X=RGBDI2" D ^DIE
27 ..D ^DIE
28 ..S NLINES=NLINES+1,^TMP("PXRMXMZ",$J,NLINES,0)=NAME
29 I NLINES=1 D
30 .S NLINES=NLINES+1
31 .S ^TMP("PXRMXMZ",$J,NLINES,0)="No dialog elements were converted."
32 D SEND^PXRMMSG("Dialog elements converted from BDI to BDI2")
33 K ^TMP("PXRMXMZ",$J)
34 Q
35CHECKRG ;
36 ;list non-National Result Groups that need to be mapped to a MH finding
37 N DIEN,NLINES,NODE,TEXT
38 K ^TMP("PXRMXMZ",$J)
39 S NLINES=0
40 S DIEN=0 F S DIEN=$O(^PXRMD(801.41,DIEN)) Q:DIEN'>0 D
41 .S NODE=$G(^PXRMD(801.41,DIEN,0))
42 .I $P(NODE,U,4)'="S" Q
43 .I $P($G(^PXRMD(801.41,DIEN,100)),U)="N" Q
44 .S TEXT="Result Group: "_$P(NODE,U)_" needs to be mapped to an MH test and scale."
45 .S NLINES=NLINES+1,^TMP("PXRMXMZ",$J,NLINES,0)=TEXT
46 .S NLINES=NLINES+1,^TMP("PXRMXMZ",$J,NLINES,0)=""
47 S TEXT="Dialog Results Groups that need to be mapped to a MH Test."
48 I NLINES>0 D SEND^PXRMMSG(TEXT)
49 K ^TMP("PXRMXMZ",$J)
50 Q
51 ;
52DCLEAN ;
53 N CNT,DA,DIEN,DIK,EARRAY,EIEN,RIEN,TEXT
54 S RIEN=$O(^PXD(811.9,"B","PXRM RESULT GROUP UPDATE REMINDER",""))
55 Q:RIEN'>0
56 S DIEN=$P($G(^PXD(811.9,RIEN,51)),U) Q:DIEN'>0
57 S TEXT="Removing transport reminder and dialog for Result Groups."
58 D MES^XPDUTL(.TEXT)
59 S CNT=0 F S CNT=$O(^PXRMD(801.41,DIEN,10,CNT)) Q:CNT'>0 D
60 .S EIEN=$P($G(^PXRMD(801.41,DIEN,10,CNT,0)),U,2)
61 .I $P($P($G(^PXRMD(801.41,EIEN,0)),U)," ")'="PXRM" Q
62 .S EARRAY(EIEN)=""
63 S DIK="^PXRMD(801.41,"
64 S DA="" F S DA=$O(EARRAY(DA)) Q:DA'>0 D ^DIK
65 S DA=DIEN D ^DIK
66 S DIK="^PXD(811.9,",DA=RIEN D ^DIK
67 Q
68 ;
69REINDEX ;
70 S DIK="^PXRMD(801.41,",DIK(1)=4 D ENALL^DIK
71 Q
72STORERG ;
73 ;store result groups for an element in XTMP
74 N CNT,DIEN,RGIEN,PXRMXTMP,TYPE
75 ;S PXRMXTMP="PXRM"_$$NOW^XLFDT
76 S PXRMXTMP="PXRM PATCH 6"
77 K ^XTMP(PXRMXTMP)
78 S ^XTMP(PXRMXTMP,0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"PXRM PATCH 6 DIALOG CONVERSION"
79 S DIEN=0,CNT=0 F S DIEN=$O(^PXRMD(801.41,DIEN)) Q:DIEN'>0 D
80 .S TYPE=$P($G(^PXRMD(801.41,DIEN,0)),U,4)
81 .I TYPE'="E",TYPE'="G" Q
82 .I $P($G(^PXRMD(801.41,DIEN,0)),U,15)="" Q
83 .S CNT=CNT+1
84 .S ^XTMP(PXRMXTMP,"PXRM DCONV",CNT)=DIEN_U_+$P($G(^PXRMD(801.41,DIEN,0)),U,15)
85 .S $P(^PXRMD(801.41,DIEN,0),U,15)=""
86 Q
87 ;
88TESTMTCH(DIEN,RIEN,NLINES) ;
89 ;validate if finding item and Result Group finding item match
90 N DNAME,DTEST,RNAME,RTEST,RESULT,TEXT
91 S DTEST=+$P($G(^PXRMD(801.41,DIEN,1)),U,5)
92 S RTEST=+$P($G(^PXRMD(801.41,RIEN,50)),U)
93 S RESULT=$S(DTEST=0:0,RTEST=0:0,DTEST'=RTEST:0,1:1)
94 I RESULT=1 Q RESULT
95 S DNAME=$P($G(^PXRMD(801.41,DIEN,0)),U)
96 ;Release with Exchange no reason to print error, entry already updated
97 I DNAME="VA-MH DOMG" Q 0
98 S RNAME=$P($G(^PXRMD(801.41,RIEN,0)),U)
99 S TEXT="Result Group: "_RNAME_" could not be moved for the following"
100 S NLINES=NLINES+1,^TMP("PXRMXMZ",$J,NLINES,0)=TEXT
101 S TEXT="element "_DNAME_"."
102 S NLINES=NLINES+1,^TMP("PXRMXMZ",$J,NLINES,0)=TEXT
103 S TEXT="Manual Correction is needed."
104 S NLINES=NLINES+1,^TMP("PXRMXMZ",$J,NLINES,0)=TEXT
105 S NLINES=NLINES+1,^TMP("PXRMXMZ",$J,NLINES,0)=""
106 ;D BMES^XPDUTL(.TEXT)
107 Q RESULT
108 ;
109WRITERG ;
110 ;write RG from XTMP back to file 801.41
111 N CNT,DA,DIE,DR,FDA,NLINES,PXRMXTMP,RGIEN,TEXT
112 S NLINES=0
113 K ^TMP("PXRMXMZ",$J)
114 S TEXT(1)="Moving Result Group to new multiple location."
115 S TEXT(2)="See MailMan message for any error."
116 D BMES^XPDUTL(.TEXT)
117 S PXRMXTMP="PXRM PATCH 6"
118 I $D(^XTMP(PXRMXTMP,"PXRM DCONV"))=0 Q
119 S CNT=0 F S CNT=$O(^XTMP(PXRMXTMP,"PXRM DCONV",CNT)) Q:CNT'>0 D
120 .S DA=$P($G(^XTMP(PXRMXTMP,"PXRM DCONV",CNT)),U)
121 .S RGIEN=$P($G(^XTMP(PXRMXTMP,"PXRM DCONV",CNT)),U,2)
122 .I $$TESTMTCH(DA,RGIEN,.NLINES)=0 Q
123 .S DA(1)=DA
124 .S FDA(801.41121,"+1,"_DA(1)_",",.01)=RGIEN
125 .D UPDATE^DIE("","FDA","","MSG")
126 .I $D(MSG)>0 D AWRITE^PXRMUTIL("MSG") H 1
127 S TEXT="Result Groups that could not be moved."
128 I NLINES>0 D SEND^PXRMMSG(TEXT)
129 K ^XTMP(PXRMXTMP)
130 K ^TMP("PXRMXMZ",$J)
131 Q
Note: See TracBrowser for help on using the repository browser.