source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMGECX.m@ 975

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

initial load of WorldVistAEHR

File size: 6.5 KB
Line 
1PXRMGECX ;SLC/JVS - GEC Debug Utilities ;08/21/2003 08:54
2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
3 ;
4 Q
5PROMPT ; Prompt for Correct Report
6 N Y,X
7 K DIR
8 S DIR("A")="Select Option or ^ to Exit"
9 S DIR("A",1)="These Reports are to Help with Degugging of Problems"
10 S DIR("A",2)="**It could take 5 minutes !! or more to Complete Reports"
11 I $D(^DISV(DUZ,"PXRMGEC","BG")) S DIR("B")=$G(^DISV(DUZ,"PXRMGEC","BG"))
12 S DIR(0)="S^B:Brief Health Factor Review;D:Detailed Health Factor Review"
13 D ^DIR
14 K DIR("A"),DIR("B"),DIR(0)
15 I Y="B" D PR1
16 I Y="D" D PR
17 Q:$D(DIRUT)!($D(DIROUT))
18 S ^DISV(DUZ,"PXRMGEC","BG")=Y
19 Q
20 ;
21DAS ;GET IENS OF TOP LEVEL DIALOGS WITH GEC IN THE IDENTITY FIELD
22 F GECI="GEC1","GEC2","GEC3","GECF" D
23 .S GECX=0 F S GECX=$O(^PXRMD(801.41,"AC",GECI,GECX)) Q:GECX="" S GECDA(GECX,GECI)=""
24 Q
25 ;
26 ;
27SCREEN(IEN) ;Screen for use in GEC Dialog Group
28 N REFB,REF10,TREE,DGIEN,IENN,GECX,GECI,DGDA,DGNA
29 N DIASYN
30 S DGNA="",DGDA=0,OK=0
31 S REFB="^PXRMD(801.41,""B"")"
32 S REF10="^PXRMD(801.41)"
33 S DGNA="VA-" F S DGNA=$O(@REFB@(DGNA)) Q:DGNA'["VA-" D
34 .S DGDA=$O(@REFB@(DGNA,0))
35 .I $P($P($G(^PXRMD(801.41,DGDA,1)),"^",5),";",1)=IEN!($$MUL(IEN,DGDA)) D
36 ..I $P($G(^PXRMD(801.41,DGDA,0)),"^",1)["HF GEC "!($P($G(^PXRMD(801.41,DGDA,0)),"^",1)["DG GEC ") S DGIEN=DGDA
37 ..I $D(DGIEN) S TREE(DGIEN)=""
38 Q:'$D(DGIEN) OK
39ST I $D(^PXRMD(801.41,"AD",DGIEN)) D
40 .S IENN=0 F S IENN=$O(^PXRMD(801.41,"AD",DGIEN,IENN)) Q:IENN=""!(OK=1) D
41 ..I $D(GECDA(IENN)) S OK=1,HFDIA(IEN,$O(GECDA(IENN,"")))="" S ^TMP("PXRMGECX",$J,"TEXT",IENN,DGIEN,IEN)=""
42 ..I OK=1 K TREE
43 ..I OK=0 S TREE(IENN)=""
44REDO I $D(TREE) D
45 .S TIEN=0 F S TIEN=$O(TREE(TIEN)) Q:TIEN=""!(OK=1) D S TIEN=0
46 ..S IENN=0 F S IENN=$O(^PXRMD(801.41,"AD",TIEN,IENN)) Q:IENN="" D
47 ...I $D(GECDA(IENN)) S OK=1,HFDIA(IEN,$O(GECDA(IENN,"")))="" S ^TMP("PXRMGECX",$J,"TEXT",IENN,DGIEN,IEN)=""
48 ...I OK=0,'$D(DONE(IENN)) S TREE(IENN)=""
49 ..K TREE(TIEN) S DONE(TIEN)=""
50 I OK=0&($D(TREE)) G REDO
51 K TREE,IENN,DONE
52 Q OK
53 ;
54MUL(IEN,DGDA) ;SEARCH ADDITONAL FINDINGS
55 N YES
56 S YES=0
57 I $D(^PXRMD(801.41,DGDA,3,"B",IEN_";AUTTHF(")) S YES=1
58 Q YES
59 ;
60HF ;Gather Health Factors
61 K ^TMP("PXRMGEC",$J,"MAN"),^TMP("PXRMGEC",$J,"MAN1")
62 N IEN,CAT,DIA,CATDA,CATNA,FNA,REF,ANS,STOP
63 S IEN=0
64 F S IEN=$O(^AUTTHF(IEN)) Q:IEN<1 D
65 .Q:$P($G(^AUTTHF(IEN,0)),"^",11)=1
66 .S FNA=$P($G(^AUTTHF(IEN,0)),"^",1)
67 .S CAT=$P($G(^AUTTHF(IEN,0)),"^",10)
68 .I CAT="F" D
69 ..Q:$P($G(^AUTTHF(IEN,0)),"^",11)=1
70 ..S CATDA=$P($G(^AUTTHF(IEN,0)),"^",3)
71 ..Q:CATDA=""
72 ..Q:$P($G(^AUTTHF(CATDA,0)),"^",11)=1
73 ..S CATNA=$P($G(^AUTTHF(CATDA,0)),"^",1)
74 ..I CATNA["GEC" D
75 ...I $P($G(^AUTTHF(CATDA,0)),"^",9)'="" D
76 ....Q:$P($G(^AUTTHF(CATDA,0)),"^",11)=1
77 ....S DIASYN=$P($G(^AUTTHF(CATDA,0)),"^",9)
78 ....S ANS=$P($G(^AUTTHF(IEN,0)),"^",9),VAL=$S(ANS'="":$P(ANS," ",$L(ANS," ")),1:0)
79 ....S ^TMP("PXRMGEC",$J,"MAN",DIASYN,CATNA,FNA,VAL,IEN,$$SCREEN(IEN))=""
80 ....I $D(HFDIA(IEN)) S ^TMP("PXRMGEC",$J,"MAN1",$O(HFDIA(IEN,"")),CATNA,FNA,VAL,IEN,$$SCREEN(IEN))=""
81 Q
82 ;
83PR ;
84 N REFM,STOPNA,TIEN,VO
85 S REF="^TMP(""PXRMGEC"",$J,""MAN"")"
86 S REFM="^TMP(""PXRMGEC"",$J,""MATCH"")"
87 S X="IOINHI;IOINLOW;IORVON;IORVOFF"
88 D ENDR^%ZISS
89 D DAS,MATCHB^PXRMGECY,MATCHB^PXRMGECZ
90 N DIACNT,CATCNT,FACCNT,IEN,VAL,STOPCNT,NEWFNA,SYN,TERM
91 S (DIACNT,CATCNT,FACCNT,STOPCNT)=0
92 D HF
93 ;
94 ;
95 S DIASYN="" F S DIASYN=$O(@REF@(DIASYN)) Q:DIASYN="" D
96 .S DIACNT=DIACNT+1
97 .W !!!,DIACNT_". Dialog- GEC REFERRAL "_$P(DIASYN," ",2,4)
98 .S CATNA="" F S CATNA=$O(@REF@(DIASYN,CATNA)) Q:CATNA="" D
99 ..K @REFM@(CATNA)
100 ..S CATCNT=CATCNT+1
101 ..W !!,DIACNT_". Dialog- GEC REFERRAL "_$P(DIASYN," ",2,4)
102 ..W !!,CATCNT_". Category- ",CATNA
103 ..W !," Synonum- "_DIASYN
104 ..W !!," Health Factors---"
105 ..S FNA="" F S FNA=$O(@REF@(DIASYN,CATNA,FNA)) Q:FNA="" D
106 ...S FACCNT=FACCNT+1
107 ...S VAL=$O(@REF@(DIASYN,CATNA,FNA,-1))
108 ...S IEN=$O(@REF@(DIASYN,CATNA,FNA,VAL,0))
109 ...S STOP=$O(@REF@(DIASYN,CATNA,FNA,VAL,IEN,-1))
110 ...I STOP=0 S STOPCNT=STOPCNT+1
111 ...S STOPNA=$S(STOP=0:"(((NOT IN USE)))",1:"")
112 ...S VO=0
113 ...I STOPNA'="" S VO=1
114 ...W !,FACCNT_". " I VO W IORVON
115 ...W FNA," ",STOPNA,IORVOFF I $L(FNA)>40 W " ",IORVON,$L(FNA),IORVOFF
116 ...W !,?19,$S('$D(@REFM@(FNA,IEN)):IORVON,1:""),"ien- "_IEN," (",$O(@REFM@(FNA,0))_")",IORVOFF I '$D(@REFM@(FNA)) W !
117 ...W ?17,IORVON,$S($D(@REFM@(FNA)):"",1:"**NOT Originally Released Name") W IORVOFF K @REFM@(FNA)
118 ...S SYN=$P($G(^AUTTHF($O(^AUTTHF("B",FNA,0)),0)),"^",9)
119 ...S TERM=$O(^PXRMD(811.5,"AF",IEN_";AUTTHF(",0))
120 ...W !,?18,$S(TERM="":IORVON,1:""),"Term- ",$S(TERM="":"NO TERM",1:$P($G(^PXRMD(811.5,TERM,0)),"^",1)),IORVOFF
121 ...I SYN="" W !,?17,IORVON,$S(SYN="":"**Synonum Missing",1:"syn- "_SYN),IORVOFF
122 ...E W !,?19,$S(SYN="":"**Synonum Missing",1:"syn- "_SYN)
123 ...W !,?19,"val- "_VAL,!
124 ...W IORVOFF
125 I $D(@REFM) W !!,?7,"**Missing Original GEC Health Factors**"
126 I $D(@REFM) S FNA="" F S FNA=$O(@REFM@(FNA)) Q:FNA="" D
127 .W !,?10,FNA
128 W !
129 W !,"Categories - "_$J(CATCNT,3)
130 W !,"Health Factors- "_$J(FACCNT,3)
131 W !,"Not in Use - "_$J(STOPCNT,3)
132 W !,"Used Factors - ",$J(((FACCNT+CATCNT)-STOPCNT),3)
133 W !
134 W !,"-----------------------------END OF REPORT ----------------------"
135 K ^TMP("PXRMGEC",$J,"MAN"),^TMP("PXRMGEC",$J,"MAN1"),HFDIA
136 K ^TMP("PXRMGEC",$J,"MATCH")
137 D KILL^%ZISS
138 Q
139 ;
140 ;
141 ;
142PR1 S REF="^TMP(""PXRMGEC"",$J,""MAN1"")"
143 S X="IOINHI;IOINLOW;IORVON;IORVOFF"
144 D ENDR^%ZISS
145 D DAS,MATCHB^PXRMGECY,MATCHB^PXRMGECZ
146 N DIACNT,CATCNT,FACCNT,IEN,VAL,STOPCNT,XCNT
147 S (DIACNT,CATCNT,FACCNT,STOPCNT)=0
148 D HF
149 ;
150DISPLAY ;REPORT DISPLAY
151 ;
152 S DIASYN="" F S DIASYN=$O(@REF@(DIASYN)) Q:DIASYN="" D
153 .S DIACNT=DIACNT+1,CATCNT=0
154 .W !!,DIACNT," Dialog- "_$P($G(^PXRMD(801.41,$O(^PXRMD(801.41,"AC",DIASYN,"")),0)),"^",1)
155 .S CATNA="" F S CATNA=$O(@REF@(DIASYN,CATNA)) Q:CATNA="" D
156 ..S CATCNT=CATCNT+1
157 ..W !!,?2,CATCNT_". Category- ",CATNA
158 ..W !,?7," Ref# (score) Health Factors---"
159 ..N FNACNT S FNACNT=0
160 ..S FNA="" F S FNA=$O(@REF@(DIASYN,CATNA,FNA)) Q:FNA="" D
161 ...S XCNT=FACCNT,FACCNT=FACCNT+1,FNACNT=FNACNT+1
162 ...S VAL=$O(@REF@(DIASYN,CATNA,FNA,-1))
163 ...S IEN=$O(@REF@(DIASYN,CATNA,FNA,VAL,0))
164 ...S STOP=$O(@REF@(DIASYN,CATNA,FNA,VAL,IEN,-1))
165 ...I STOP=0 S FACCNT=XCNT
166 ...I STOP=0 S STOPCNT=STOPCNT+1 Q
167 ...S STOPNA=$S(STOP=0:"(((NOT IN USE)))",1:"")
168 ...N COMB S COMB=DIACNT_"."_CATCNT_"."_FNACNT_" ("_VAL_")"
169 ...S VO=0
170 ...I STOPNA'="" S VO=1
171 ...W !," " I VO W IORVON
172 ...W ?11,COMB," "_FNA," ",STOPNA,IORVOFF W " "
173 ...;==================================================
174 ...W IORVOFF
175 W !!,"Health Factors- "_$J(FACCNT,3)
176 W !
177 W !,"-----------------------------END OF REPORT ----------------------"
178 K ^TMP("PXRMGEC",$J,"MAN"),^TMP("PXRMGEC",$J,"MAN1"),HFDIA
179 K ^TMP("PXRMGEC",$J,"MATCH")
180 D KILL^%ZISS
181 Q
182 ;
Note: See TracBrowser for help on using the repository browser.