source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMRPCB.m@ 1306

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

initial load of WorldVistAEHR

File size: 2.5 KB
RevLine 
[613]1PXRMRPCB ; SLC/PJH - Functions returning REMINDER data ;01/03/2000
2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
3 Q
4 ;
5EDL(ORY,OREM) ;return list of education topics for a reminder
6 ; ien^name^print name
7 ;
8 N DATA,EDIEN,EDNAME,EDPNAM,FIND,ELIST,OCNT,SUB
9 S SUB=0,OCNT=0
10 F S SUB=$O(^PXD(811.9,OREM,20,SUB)) Q:'SUB D
11 .S FIND=$P($G(^PXD(811.9,OREM,20,SUB,0)),U)
12 .I $P(FIND,";",2)="AUTTEDT(" D EDTP(FIND) Q
13 .I $P(FIND,";",2)="PXRMD(811.5," D EDTERM($P(FIND,";")) Q
14 Q
15 ;
16EDTERM(TERM) ;Get any education topics on the reminder term
17 N TSUB,TFIND
18 S TSUB=0
19 F S TSUB=$O(^PXRMD(811.5,TERM,20,TSUB)) Q:'TSUB D
20 .S TFIND=$P($G(^PXRMD(811.5,TERM,20,TSUB,0)),U) Q:TFIND=""
21 .I $P(TFIND,U)["AUTTEDT(" D EDTP(TFIND)
22 Q
23 ;
24EDTP(FIND) ;Get education topic name
25 S EDIEN=$P(FIND,";") Q:'EDIEN Q:$D(ELIST(EDIEN)) S ELIST(EDIEN)=""
26 S DATA=$G(^AUTTEDT(EDIEN,0)) Q:DATA=""
27 S EDPNAM=$P(DATA,U,4),EDNAME=$P(DATA,U)
28 S OCNT=OCNT+1,ORY(OCNT)=EDIEN_U_EDNAME_U_EDPNAM
29 Q
30 ;
31EDU(ORY,OREDU) ;return education details in WP format
32 ; display text only
33 ;
34 N DIC,DR,DA,DIQ
35 K ^UTILITY("DIQ1",$J)
36 S DR=".01;.04;11;12"
37 S DIC=9999999.09
38 S DA=OREDU
39 S DIQ(0)="EN"
40 D EN^DIQ1
41 ;
42 ; Construct output array
43 N OCNT,SUB,SUB1,LIT,IC,LITS
44 S DIC=9999999.09,OCNT=0
45 S LITS="NAME : ;PRINT NAME : ;EDUCATIONAL OUTCOME : ;"
46 S LITS=LITS_"EDUCATIONAL STANDARDS : "
47 F IC=1:1 S SUB=$P(DR,";",IC),LIT=$P(LITS,";",IC) Q:SUB="" D
48 .S SUB1="",OCNT=OCNT+1,ORY(OCNT)=" "
49 .I IC>2 S ORY(OCNT+1)=LIT,LIT="",OCNT=OCNT+2,ORY(OCNT)=" "
50 .F S SUB1=$O(^UTILITY("DIQ1",$J,DIC,OREDU,SUB,SUB1)) Q:SUB1="" D
51 ..S OCNT=OCNT+1
52 ..S ORY(OCNT)=LIT_$G(^UTILITY("DIQ1",$J,DIC,OREDU,SUB,SUB1))
53 ..S LIT=""
54 K ^UTILITY("DIQ1",$J)
55 Q
56 ;
57EDS(ORY,OREDU) ;return education subtopics
58 ; ien^name^sub-topic sequence number
59 ;
60 N DIC,DR,DA,DATA,DIQ,NODE,NULL,OCNT,REF,SUB,TEMP
61 N EDIEN,EDNAME,EDSEQ,EDPNAM
62 S NULL=1,OCNT=0
63 K ^UTILITY("DIQ1",$J)
64 F NODE=1:1 D Q:EDIEN=""
65 .S REF=9999999.091001
66 .S DR=10
67 .S DA(REF)=NODE
68 .S DR(REF)=".01;3"
69 .S DIC=9999999.09
70 .S DA=OREDU
71 .S DIQ(0)="EIN"
72 .D EN^DIQ1
73 .S EDIEN=$G(^UTILITY("DIQ1",$J,REF,NODE,.01,"I"))
74 .I EDIEN="" K ^UTILITY("DIQ1",$J) Q
75 .S EDNAME=$G(^UTILITY("DIQ1",$J,REF,NODE,.01,"E"))
76 .S EDSEQ=$G(^UTILITY("DIQ1",$J,REF,NODE,3,"E")) S:EDSEQ="" EDSEQ=" "
77 .S EDPNAM=$P($G(^AUTTEDT(EDIEN,0)),U,4)
78 .S TEMP(EDSEQ,EDIEN)=EDIEN_U_EDNAME_U_EDPNAM_U_EDSEQ
79 .K ^UTILITY("DIQ1",$J)
80 ;Output array in sequence order
81 S EDSEQ=""
82 F S EDSEQ=$O(TEMP(EDSEQ)) Q:EDSEQ="" D
83 .S EDIEN=""
84 .F S EDIEN=$O(TEMP(EDSEQ,EDIEN)) Q:EDIEN="" D
85 ..S OCNT=OCNT+1,ORY(OCNT)=TEMP(EDSEQ,EDIEN)
86 Q
Note: See TracBrowser for help on using the repository browser.