1 | C0Q1P2 ; VEN/SMH - Kids utilities for C0Q 1.0 patch 1 ; 7/17/12 12:14pm
|
---|
2 | ;;1.0;QUALITY MEASURES;*1*;July 13, 2112;
|
---|
3 | ; Licensed under package license. See Documentation
|
---|
4 | ;
|
---|
5 | ; PEPs: PRE, TRAN, POST
|
---|
6 | ;
|
---|
7 | PRE ; Unified Pre; PEP
|
---|
8 | D PREREM
|
---|
9 | QUIT
|
---|
10 | TRAN ; Unified Tran; PEP
|
---|
11 | QUIT
|
---|
12 | POST ; Unified Post; PEP
|
---|
13 | D POSTREM
|
---|
14 | QUIT
|
---|
15 | ;
|
---|
16 | ; Rest of entry points are private
|
---|
17 | ;
|
---|
18 | ;
|
---|
19 | ARRAY(MODE,ARRAY) ;List of exchange entries used by delete and install
|
---|
20 | ;
|
---|
21 | N LN S LN=1
|
---|
22 | ;
|
---|
23 | ; NQF 0024-alt-core_wt-kids
|
---|
24 | ; NB: Commented out. Reminder needs to be re-done to include BMI %tile
|
---|
25 | ; S ARRAY(LN,1)="MU NQF0024 BMI_MK"
|
---|
26 | ; I MODE S ARRAY(LN,2)="07/06/2011@15:11:46"
|
---|
27 | ; S LN=LN+1
|
---|
28 | ;
|
---|
29 | ; NQF 0013-core-HTN
|
---|
30 | S ARRAY(LN,1)="MU NQF0013 HTN_MK"
|
---|
31 | I MODE S ARRAY(LN,2)="07/06/2011@15:08:53"
|
---|
32 | S LN=LN+1
|
---|
33 | ;
|
---|
34 | ; NQF 0028a-core-tobacco-access
|
---|
35 | ; NQF 0028b-core-tobaocc-intervention
|
---|
36 | ; Both are in the first; dialog is in the second.
|
---|
37 | S ARRAY(LN,1)="MU NQF0028 TOBACCO_MK"
|
---|
38 | I MODE S ARRAY(LN,2)="07/06/2011@15:14:49"
|
---|
39 | S LN=LN+1
|
---|
40 | S ARRAY(LN,1)="MU NQF0028AB MANAGEMENT DI"
|
---|
41 | I MODE S ARRAY(LN,2)="06/08/2011@16:50:31"
|
---|
42 | S LN=LN+1
|
---|
43 | ;
|
---|
44 | ; NQF 0041-alt-core-flu
|
---|
45 | S ARRAY(LN,1)="MU NQF0041 FLU_MK"
|
---|
46 | I MODE S ARRAY(LN,2)="07/06/2011@15:26:59"
|
---|
47 | S LN=LN+1
|
---|
48 | ;
|
---|
49 | ; NQF 0059-option1-DM-Hbalc
|
---|
50 | ; NQF 0061-option3-DM-BP
|
---|
51 | ; NQF 0064-option2-DM-LDL
|
---|
52 | ; All are in One Reminder Exchange entry
|
---|
53 | S ARRAY(LN,1)="MU NQF0059_61_64_SMH"
|
---|
54 | I MODE S ARRAY(LN,2)="07/16/2012@10:46:17"
|
---|
55 | S LN=LN+1
|
---|
56 | ;
|
---|
57 | ; Inpatient Education Reminders (popularly known as ED-1 and ED-2)
|
---|
58 | ; NQF 0495
|
---|
59 | ; NQF 0497
|
---|
60 | S ARRAY(LN,1)="MU NQF 0495 ED-1"
|
---|
61 | I MODE S ARRAY(LN,2)="07/17/2012@11:47:55"
|
---|
62 | S LN=LN+1
|
---|
63 | S ARRAY(LN,1)="MU NQF 0497 ED-2"
|
---|
64 | I MODE S ARRAY(LN,2)="07/17/2012@11:50:23"
|
---|
65 | S LN=LN+1
|
---|
66 | Q
|
---|
67 | ;
|
---|
68 | ;===============================================================
|
---|
69 | DELEI ;If the Exchange File entry already exists delete it.
|
---|
70 | N ARRAY,IC,IND,LIST,LUVALUE,NUM
|
---|
71 | D ARRAY(1,.ARRAY)
|
---|
72 | S IC=0
|
---|
73 | F S IC=$O(ARRAY(IC)) Q:'IC D
|
---|
74 | .S LUVALUE(1)=ARRAY(IC,1)
|
---|
75 | .D FIND^DIC(811.8,"","","U",.LUVALUE,"","","","","LIST")
|
---|
76 | .I '$D(LIST) Q
|
---|
77 | .S NUM=$P(LIST("DILIST",0),U,1)
|
---|
78 | .I NUM'=0 D
|
---|
79 | ..F IND=1:1:NUM D
|
---|
80 | ... N DA,DIK
|
---|
81 | ... S DIK="^PXD(811.8,"
|
---|
82 | ... S DA=LIST("DILIST",2,IND)
|
---|
83 | ... D ^DIK
|
---|
84 | Q
|
---|
85 | ;
|
---|
86 | ;===============================================================
|
---|
87 | EXFINC(Y) ;Return a 1 if the Exchange file entry is in the list to
|
---|
88 | ;include in the build. This is used in the build to determine which
|
---|
89 | ;entries to include.
|
---|
90 | N ARRAY,FOUND,IEN,IC,LUVALUE
|
---|
91 | D ARRAY(1,.ARRAY)
|
---|
92 | S FOUND=0
|
---|
93 | S IC=0
|
---|
94 | F S IC=+$O(ARRAY(IC)) Q:(IC=0)!(FOUND) D
|
---|
95 | . M LUVALUE=ARRAY(IC)
|
---|
96 | . S IEN=+$$FIND1^DIC(811.8,"","KU",.LUVALUE)
|
---|
97 | . I IEN=Y S FOUND=1 Q
|
---|
98 | Q FOUND
|
---|
99 | ;
|
---|
100 | PREREM ;
|
---|
101 | D DELEI
|
---|
102 | Q
|
---|
103 | POSTREM ;
|
---|
104 | D SMEXINS
|
---|
105 | Q
|
---|
106 | ;===============================================================
|
---|
107 | SMEXINS ;Silent mode install.
|
---|
108 | N ARRAY,IC,IEN,LUVALUE,PXRMINST
|
---|
109 | S PXRMINST=1
|
---|
110 | D ARRAY(1,.ARRAY)
|
---|
111 | S IC=0
|
---|
112 | F S IC=$O(ARRAY(IC)) Q:'IC D
|
---|
113 | .M LUVALUE=ARRAY(IC)
|
---|
114 | .S IEN=+$$FIND1^DIC(811.8,"","KU",.LUVALUE)
|
---|
115 | .I IEN'=0 D
|
---|
116 | .. N TEXT
|
---|
117 | .. I LUVALUE(1)["PARAMETER" S TEXT="Installing entry "_LUVALUE(1)
|
---|
118 | .. E S TEXT="Installing reminder exchange entry "_LUVALUE(1)
|
---|
119 | .. D BMES^XPDUTL(TEXT)
|
---|
120 | .. D INSTALL^PXRMEXSI(IEN,"I",1)
|
---|
121 | Q
|
---|
122 | ;
|
---|
123 | CRPL(PLNAME,C0QERR) ; Private ; $$ ; Create Patient List
|
---|
124 | ; Input: PLNAME: By Value: Patient List Name
|
---|
125 | ; C0QERR: By Ref: Error Array
|
---|
126 | ; Output: IEN of Patient List, or -1 for error
|
---|
127 | N C0QFDA,C0QIENS ; FDA, return IEN
|
---|
128 | S C0QFDA(810.5,"?+1,",.01)=PLNAME ; Patient List Name
|
---|
129 | S C0QFDA(810.5,"?+1,",.07)="`"_DUZ ; Creator
|
---|
130 | S C0QFDA(810.5,"?+1,",.08)="PUB" ; Type: Public
|
---|
131 | S C0QFDA(810.5,"?+1,",100)="L" ; Class: Local
|
---|
132 | D UPDATE^DIE("E",$NA(C0QFDA),$NA(C0QIENS),$NA(C0QERR)) ; External Flag
|
---|
133 | I $G(C0QIENS(1)) QUIT C0QIENS(1)
|
---|
134 | E QUIT -1
|
---|