Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXRMRPCB

PXRMRPCB.m

Go to the documentation of this file.
  1. PXRMRPCB ; SLC/PJH - Functions returning REMINDER data ;01/03/2000
  1. ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
  1. Q
  1. ;
  1. EDL(ORY,OREM) ;return list of education topics for a reminder
  1. ; ien^name^print name
  1. ;
  1. N DATA,EDIEN,EDNAME,EDPNAM,FIND,ELIST,OCNT,SUB
  1. S SUB=0,OCNT=0
  1. F S SUB=$O(^PXD(811.9,OREM,20,SUB)) Q:'SUB D
  1. .S FIND=$P($G(^PXD(811.9,OREM,20,SUB,0)),U)
  1. .I $P(FIND,";",2)="AUTTEDT(" D EDTP(FIND) Q
  1. .I $P(FIND,";",2)="PXRMD(811.5," D EDTERM($P(FIND,";")) Q
  1. Q
  1. ;
  1. EDTERM(TERM) ;Get any education topics on the reminder term
  1. N TSUB,TFIND
  1. S TSUB=0
  1. F S TSUB=$O(^PXRMD(811.5,TERM,20,TSUB)) Q:'TSUB D
  1. .S TFIND=$P($G(^PXRMD(811.5,TERM,20,TSUB,0)),U) Q:TFIND=""
  1. .I $P(TFIND,U)["AUTTEDT(" D EDTP(TFIND)
  1. Q
  1. ;
  1. EDTP(FIND) ;Get education topic name
  1. S EDIEN=$P(FIND,";") Q:'EDIEN Q:$D(ELIST(EDIEN)) S ELIST(EDIEN)=""
  1. S DATA=$G(^AUTTEDT(EDIEN,0)) Q:DATA=""
  1. S EDPNAM=$P(DATA,U,4),EDNAME=$P(DATA,U)
  1. S OCNT=OCNT+1,ORY(OCNT)=EDIEN_U_EDNAME_U_EDPNAM
  1. Q
  1. ;
  1. EDU(ORY,OREDU) ;return education details in WP format
  1. ; display text only
  1. ;
  1. N DIC,DR,DA,DIQ
  1. K ^UTILITY("DIQ1",$J)
  1. S DR=".01;.04;11;12"
  1. S DIC=9999999.09
  1. S DA=OREDU
  1. S DIQ(0)="EN"
  1. D EN^DIQ1
  1. ;
  1. ; Construct output array
  1. N OCNT,SUB,SUB1,LIT,IC,LITS
  1. S DIC=9999999.09,OCNT=0
  1. S LITS="NAME : ;PRINT NAME : ;EDUCATIONAL OUTCOME : ;"
  1. S LITS=LITS_"EDUCATIONAL STANDARDS : "
  1. F IC=1:1 S SUB=$P(DR,";",IC),LIT=$P(LITS,";",IC) Q:SUB="" D
  1. .S SUB1="",OCNT=OCNT+1,ORY(OCNT)=" "
  1. .I IC>2 S ORY(OCNT+1)=LIT,LIT="",OCNT=OCNT+2,ORY(OCNT)=" "
  1. .F S SUB1=$O(^UTILITY("DIQ1",$J,DIC,OREDU,SUB,SUB1)) Q:SUB1="" D
  1. ..S OCNT=OCNT+1
  1. ..S ORY(OCNT)=LIT_$G(^UTILITY("DIQ1",$J,DIC,OREDU,SUB,SUB1))
  1. ..S LIT=""
  1. K ^UTILITY("DIQ1",$J)
  1. Q
  1. ;
  1. EDS(ORY,OREDU) ;return education subtopics
  1. ; ien^name^sub-topic sequence number
  1. ;
  1. N DIC,DR,DA,DATA,DIQ,NODE,NULL,OCNT,REF,SUB,TEMP
  1. N EDIEN,EDNAME,EDSEQ,EDPNAM
  1. S NULL=1,OCNT=0
  1. K ^UTILITY("DIQ1",$J)
  1. F NODE=1:1 D Q:EDIEN=""
  1. .S REF=9999999.091001
  1. .S DR=10
  1. .S DA(REF)=NODE
  1. .S DR(REF)=".01;3"
  1. .S DIC=9999999.09
  1. .S DA=OREDU
  1. .S DIQ(0)="EIN"
  1. .D EN^DIQ1
  1. .S EDIEN=$G(^UTILITY("DIQ1",$J,REF,NODE,.01,"I"))
  1. .I EDIEN="" K ^UTILITY("DIQ1",$J) Q
  1. .S EDNAME=$G(^UTILITY("DIQ1",$J,REF,NODE,.01,"E"))
  1. .S EDSEQ=$G(^UTILITY("DIQ1",$J,REF,NODE,3,"E")) S:EDSEQ="" EDSEQ=" "
  1. .S EDPNAM=$P($G(^AUTTEDT(EDIEN,0)),U,4)
  1. .S TEMP(EDSEQ,EDIEN)=EDIEN_U_EDNAME_U_EDPNAM_U_EDSEQ
  1. .K ^UTILITY("DIQ1",$J)
  1. ;Output array in sequence order
  1. S EDSEQ=""
  1. F S EDSEQ=$O(TEMP(EDSEQ)) Q:EDSEQ="" D
  1. .S EDIEN=""
  1. .F S EDIEN=$O(TEMP(EDSEQ,EDIEN)) Q:EDIEN="" D
  1. ..S OCNT=OCNT+1,ORY(OCNT)=TEMP(EDSEQ,EDIEN)
  1. Q