| 1 | PXRMRPCB ; SLC/PJH - Functions returning REMINDER data ;01/03/2000
|
|---|
| 2 | ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
|
|---|
| 3 | Q
|
|---|
| 4 | ;
|
|---|
| 5 | EDL(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 | ;
|
|---|
| 16 | EDTERM(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 | ;
|
|---|
| 24 | EDTP(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 | ;
|
|---|
| 31 | EDU(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 | ;
|
|---|
| 57 | EDS(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
|
|---|
