source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMWHPI.m@ 794

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

initial load of FOIAVistA 6/30/08 version
File size: 4.1 KB
Line 
1PXRMWHPI ; SLC/AGP - Inits for PXRM*2.0*1 ;11/16/2004
2 ;;2.0;CLINICAL REMINDERS;**1**;Feb 04, 2005
3 ;
4 Q
5PRE ;
6 D DELEI
7 D COND
8 D REVIEW
9 Q
10 ;
11POST ;
12 D INSTALL
13 D UPDATE
14 Q
15 ;
16COND ;
17 N CFIEN,CFNAME,COND,DA,DIE,DR,NAME,NUM,TIEN,PXRMINST
18 S PXRMINST=1
19 S CFIEN=$O(^PXRMD(811.4,"B","VA-WH PAP SMEAR IN LAB PKG","")) Q:CFIEN'>0
20 S CFNAME=CFIEN_";PXRMD(811.4,"
21 F NAME="VA-WH PAP SMEAR SCREEN IN LAB PKG","VA-WH PAP SMEAR UNSATISFACTORY IN LAB/WH PKG" D
22 .S TIEN=$O(^PXRMD(811.5,NAME,"")) I TIEN'>0 Q
23 .S DA(1)=TIEN
24 .I NAME="VA-WH PAP SMEAR UNSATISFACTORY IN LAB/WH PKG" D
25 ..S COND="I V(""UNSATISFACTORY"")=""T"""
26 .I NAME="VA-WH PAP SMEAR SCREEN IN LAB PKG" D
27 ..S COND="I V(""UNSATISFACTORY"")=""F"""
28 .S NUM=0 F S NUM=$O(^PXRMD(811.5,TIEN,20,NUM)) Q:NUM'>0 D Q
29 ..I $G(^PXRMD(811.5,TIEN,20,NUM,0))'[CFNAME Q
30 ..S DA=NUM,DIE="^PXRMD(811.5,"_DA(1)_",20,",DR="14///^S X=COND"
31 ..D ^DIE
32 Q
33 ;
34DELEI ;If the Exchange File entry already exists delete it.
35 ;
36 N IND,LIST,LUVALUE,NUM
37 ;
38 ;
39 S LUVALUE(1)="VA-WH MAMMOGRAM REVIEW RESULTS"
40 D FIND^DIC(811.8,"","","U",.LUVALUE,"","","","","LIST")
41 S NUM=$P(LIST("DILIST",0),U,1)
42 I NUM'=0 D
43 .F IND=1:1:NUM D
44 .. N DA,DIK
45 .. S DIK="^PXD(811.8,"
46 .. S DA=LIST("DILIST",2,IND)
47 .. D ^DIK
48 ;
49 S LUVALUE(1)="VA-WH MAMMOGRAM SCREENING"
50 D FIND^DIC(811.8,"","","U",.LUVALUE,"","","","","LIST")
51 S NUM=$P(LIST("DILIST",0),U,1)
52 I NUM'=0 D
53 .F IND=1:1:NUM D
54 .. N DA,DIK
55 .. S DIK="^PXD(811.8,"
56 .. S DA=LIST("DILIST",2,IND)
57 .. D ^DIK
58 ;
59 S LUVALUE(1)="VA-WH PAP SMEAR REVIEW RESULTS"
60 D FIND^DIC(811.8,"","","U",.LUVALUE,"","","","","LIST")
61 S NUM=$P(LIST("DILIST",0),U,1)
62 I NUM'=0 D
63 .F IND=1:1:NUM D
64 .. N DA,DIK
65 .. S DIK="^PXD(811.8,"
66 .. S DA=LIST("DILIST",2,IND)
67 .. D ^DIK
68 ;
69 S LUVALUE(1)="VA-WH PAP SMEAR SCREENING"
70 D FIND^DIC(811.8,"","","U",.LUVALUE,"","","","","LIST")
71 S NUM=$P(LIST("DILIST",0),U,1)
72 I NUM'=0 D
73 .F IND=1:1:NUM D
74 .. N DA,DIK
75 .. S DIK="^PXD(811.8,"
76 .. S DA=LIST("DILIST",2,IND)
77 .. D ^DIK
78 Q
79 ;
80REVIEW ;
81 N TIEN,CFIEN,CFNAME,DA,DIE,DR,NAME,NNAME,NEW,PXRMINST
82 S PXRMINST=1
83 S DIE="^PXRMD(811.5,",NEW=1
84 F NAME="VA-WH MAMMOGRAM PENDING REVIEW ","VA-WH PAP SMEAR PENDING REVIEW" D
85 .S TIEN=$O(^PXRMD(811.5,"B",NAME,"")) Q:TIEN'>0
86 .I NAME["MAMMOGRAM" D
87 ..S NNAME="VA-WH MAMMOGRAM PENDING REVIEW",DA=TIEN
88 ..S DR=".01///^S X=NNAME" D ^DIE
89 ..S DA(1)=DA
90 ..S CFIEN=$O(^PXRMD(811.4,"B","VA-WH MAMMOGRAM IN WH PKG","")) Q:CFIEN'>0
91 ..S CFNAME=CFIEN_";PXRMD(811.4,"
92 ..S DA=$O(^PXRMD(811.5,DA(1),20,"B",CFNAME,"")) Q:DA'>0
93 ..S DIE="^PXRMD(811.5,"_DA(1)_",20,",DR="15///^S X=NEW"
94 ..D ^DIE
95 .I NAME["PAP" D
96 ..S DA(1)=TIEN
97 ..S CFIEN=$O(^PXRMD(811.4,"B","VA-WH PAP SMEAR IN WH PKG","")) Q:CFIEN'>0
98 ..S CFNAME=CFIEN_";PXRMD(811.4,"
99 ..S DA=$O(^PXRMD(811.5,DA(1),20,"B",CFNAME,"")) Q:DA'>0
100 ..S DIE="^PXRMD(811.5,"_DA(1)_",20,",DR="15///^S X=NEW"
101 ..D ^DIE
102 Q
103 ;
104INSTALL ;Silent mode install.
105 N IEN,LUVALUE
106 ;
107 S PXRMINST=1
108 ;
109 S LUVALUE(1)="VA-WH MAMMOGRAM REVIEW RESULTS"
110 S LUVALUE(2)="02/04/2005@17:11:10"
111 S IEN=+$$FIND1^DIC(811.8,"","KU",.LUVALUE)
112 I IEN'=0 D
113 . N TEXT
114 . S TEXT="Installing reminder "_LUVALUE(1)
115 . D BMES^XPDUTL(TEXT)
116 . D INSTALL^PXRMEXSI(IEN)
117 ;
118 ;
119 S LUVALUE(1)="VA-WH MAMMOGRAM SCREENING"
120 S LUVALUE(2)="02/04/2005@17:11:35"
121 S IEN=+$$FIND1^DIC(811.8,"","KU",.LUVALUE)
122 I IEN'=0 D
123 . N TEXT
124 . S TEXT="Installing reminder "_LUVALUE(1)
125 . D BMES^XPDUTL(TEXT)
126 . D INSTALL^PXRMEXSI(IEN)
127 ;
128 ;
129 S LUVALUE(1)="VA-WH PAP SMEAR REVIEW RESULTS"
130 S LUVALUE(2)="02/04/2005@17:12:10"
131 S IEN=+$$FIND1^DIC(811.8,"","KU",.LUVALUE)
132 I IEN'=0 D
133 . N TEXT
134 . S TEXT="Installing reminder "_LUVALUE(1)
135 . D BMES^XPDUTL(TEXT)
136 . D INSTALL^PXRMEXSI(IEN)
137 ;
138 S LUVALUE(1)="VA-WH PAP SMEAR SCREENING"
139 S LUVALUE(2)="02/04/2005@17:12:52"
140 S IEN=+$$FIND1^DIC(811.8,"","KU",.LUVALUE)
141 I IEN'=0 D
142 . N TEXT
143 . S TEXT="Installing reminder "_LUVALUE(1)
144 . D BMES^XPDUTL(TEXT)
145 . D INSTALL^PXRMEXSI(IEN)
146 Q
147 ;
148UPDATE ;
149 N DA,DIE,DR,WHIEN,PIEN,PNAME
150 S WHIEN=$O(^PXRMD(801.45,"B","WH","")) Q:WHIEN'>0
151 F PNAME="PXRM WH UPDATE TREATMENT NEED","PXRM WH NOTIFICATION TYPE" D
152 .S DIE="^PXRMD(801.41,",DR="14////^S X=WHIEN"
153 .S DA=$O(^PXRMD(801.41,"B",PNAME,"")) Q:DA'>0
154 .D ^DIE
155 .W !,"UPDATING FORCE VALUE: "_PNAME
156 Q
Note: See TracBrowser for help on using the repository browser.