PXRMRPCB ; SLC/PJH - Functions returning REMINDER data ;01/03/2000
;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
Q
;
EDL(ORY,OREM) ;return list of education topics for a reminder
; ien^name^print name
;
N DATA,EDIEN,EDNAME,EDPNAM,FIND,ELIST,OCNT,SUB
S SUB=0,OCNT=0
F S SUB=$O(^PXD(811.9,OREM,20,SUB)) Q:'SUB D
.S FIND=$P($G(^PXD(811.9,OREM,20,SUB,0)),U)
.I $P(FIND,";",2)="AUTTEDT(" D EDTP(FIND) Q
.I $P(FIND,";",2)="PXRMD(811.5," D EDTERM($P(FIND,";")) Q
Q
;
EDTERM(TERM) ;Get any education topics on the reminder term
N TSUB,TFIND
S TSUB=0
F S TSUB=$O(^PXRMD(811.5,TERM,20,TSUB)) Q:'TSUB D
.S TFIND=$P($G(^PXRMD(811.5,TERM,20,TSUB,0)),U) Q:TFIND=""
.I $P(TFIND,U)["AUTTEDT(" D EDTP(TFIND)
Q
;
EDTP(FIND) ;Get education topic name
S EDIEN=$P(FIND,";") Q:'EDIEN Q:$D(ELIST(EDIEN)) S ELIST(EDIEN)=""
S DATA=$G(^AUTTEDT(EDIEN,0)) Q:DATA=""
S EDPNAM=$P(DATA,U,4),EDNAME=$P(DATA,U)
S OCNT=OCNT+1,ORY(OCNT)=EDIEN_U_EDNAME_U_EDPNAM
Q
;
EDU(ORY,OREDU) ;return education details in WP format
; display text only
;
N DIC,DR,DA,DIQ
K ^UTILITY("DIQ1",$J)
S DR=".01;.04;11;12"
S DIC=9999999.09
S DA=OREDU
S DIQ(0)="EN"
D EN^DIQ1
;
; Construct output array
N OCNT,SUB,SUB1,LIT,IC,LITS
S DIC=9999999.09,OCNT=0
S LITS="NAME : ;PRINT NAME : ;EDUCATIONAL OUTCOME : ;"
S LITS=LITS_"EDUCATIONAL STANDARDS : "
F IC=1:1 S SUB=$P(DR,";",IC),LIT=$P(LITS,";",IC) Q:SUB="" D
.S SUB1="",OCNT=OCNT+1,ORY(OCNT)=" "
.I IC>2 S ORY(OCNT+1)=LIT,LIT="",OCNT=OCNT+2,ORY(OCNT)=" "
.F S SUB1=$O(^UTILITY("DIQ1",$J,DIC,OREDU,SUB,SUB1)) Q:SUB1="" D
..S OCNT=OCNT+1
..S ORY(OCNT)=LIT_$G(^UTILITY("DIQ1",$J,DIC,OREDU,SUB,SUB1))
..S LIT=""
K ^UTILITY("DIQ1",$J)
Q
;
EDS(ORY,OREDU) ;return education subtopics
; ien^name^sub-topic sequence number
;
N DIC,DR,DA,DATA,DIQ,NODE,NULL,OCNT,REF,SUB,TEMP
N EDIEN,EDNAME,EDSEQ,EDPNAM
S NULL=1,OCNT=0
K ^UTILITY("DIQ1",$J)
F NODE=1:1 D Q:EDIEN=""
.S REF=9999999.091001
.S DR=10
.S DA(REF)=NODE
.S DR(REF)=".01;3"
.S DIC=9999999.09
.S DA=OREDU
.S DIQ(0)="EIN"
.D EN^DIQ1
.S EDIEN=$G(^UTILITY("DIQ1",$J,REF,NODE,.01,"I"))
.I EDIEN="" K ^UTILITY("DIQ1",$J) Q
.S EDNAME=$G(^UTILITY("DIQ1",$J,REF,NODE,.01,"E"))
.S EDSEQ=$G(^UTILITY("DIQ1",$J,REF,NODE,3,"E")) S:EDSEQ="" EDSEQ=" "
.S EDPNAM=$P($G(^AUTTEDT(EDIEN,0)),U,4)
.S TEMP(EDSEQ,EDIEN)=EDIEN_U_EDNAME_U_EDPNAM_U_EDSEQ
.K ^UTILITY("DIQ1",$J)
;Output array in sequence order
S EDSEQ=""
F S EDSEQ=$O(TEMP(EDSEQ)) Q:EDSEQ="" D
.S EDIEN=""
.F S EDIEN=$O(TEMP(EDSEQ,EDIEN)) Q:EDIEN="" D
..S OCNT=OCNT+1,ORY(OCNT)=TEMP(EDSEQ,EDIEN)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMRPCB 2651 printed Apr 09, 2024@20:50:09 Page 2
PXRMRPCB ; SLC/PJH - Functions returning REMINDER data ;01/03/2000
+1 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
+2 QUIT
+3 ;
EDL(ORY,OREM) ;return list of education topics for a reminder
+1 ; ien^name^print name
+2 ;
+3 NEW DATA,EDIEN,EDNAME,EDPNAM,FIND,ELIST,OCNT,SUB
+4 SET SUB=0
SET OCNT=0
+5 FOR
SET SUB=$ORDER(^PXD(811.9,OREM,20,SUB))
if 'SUB
QUIT
Begin DoDot:1
+6 SET FIND=$PIECE($GET(^PXD(811.9,OREM,20,SUB,0)),U)
+7 IF $PIECE(FIND,";",2)="AUTTEDT("
DO EDTP(FIND)
QUIT
+8 IF $PIECE(FIND,";",2)="PXRMD(811.5,"
DO EDTERM($PIECE(FIND,";"))
QUIT
End DoDot:1
+9 QUIT
+10 ;
EDTERM(TERM) ;Get any education topics on the reminder term
+1 NEW TSUB,TFIND
+2 SET TSUB=0
+3 FOR
SET TSUB=$ORDER(^PXRMD(811.5,TERM,20,TSUB))
if 'TSUB
QUIT
Begin DoDot:1
+4 SET TFIND=$PIECE($GET(^PXRMD(811.5,TERM,20,TSUB,0)),U)
if TFIND=""
QUIT
+5 IF $PIECE(TFIND,U)["AUTTEDT("
DO EDTP(TFIND)
End DoDot:1
+6 QUIT
+7 ;
EDTP(FIND) ;Get education topic name
+1 SET EDIEN=$PIECE(FIND,";")
if 'EDIEN
QUIT
if $DATA(ELIST(EDIEN))
QUIT
SET ELIST(EDIEN)=""
+2 SET DATA=$GET(^AUTTEDT(EDIEN,0))
if DATA=""
QUIT
+3 SET EDPNAM=$PIECE(DATA,U,4)
SET EDNAME=$PIECE(DATA,U)
+4 SET OCNT=OCNT+1
SET ORY(OCNT)=EDIEN_U_EDNAME_U_EDPNAM
+5 QUIT
+6 ;
EDU(ORY,OREDU) ;return education details in WP format
+1 ; display text only
+2 ;
+3 NEW DIC,DR,DA,DIQ
+4 KILL ^UTILITY("DIQ1",$JOB)
+5 SET DR=".01;.04;11;12"
+6 SET DIC=9999999.09
+7 SET DA=OREDU
+8 SET DIQ(0)="EN"
+9 DO EN^DIQ1
+10 ;
+11 ; Construct output array
+12 NEW OCNT,SUB,SUB1,LIT,IC,LITS
+13 SET DIC=9999999.09
SET OCNT=0
+14 SET LITS="NAME : ;PRINT NAME : ;EDUCATIONAL OUTCOME : ;"
+15 SET LITS=LITS_"EDUCATIONAL STANDARDS : "
+16 FOR IC=1:1
SET SUB=$PIECE(DR,";",IC)
SET LIT=$PIECE(LITS,";",IC)
if SUB=""
QUIT
Begin DoDot:1
+17 SET SUB1=""
SET OCNT=OCNT+1
SET ORY(OCNT)=" "
+18 IF IC>2
SET ORY(OCNT+1)=LIT
SET LIT=""
SET OCNT=OCNT+2
SET ORY(OCNT)=" "
+19 FOR
SET SUB1=$ORDER(^UTILITY("DIQ1",$JOB,DIC,OREDU,SUB,SUB1))
if SUB1=""
QUIT
Begin DoDot:2
+20 SET OCNT=OCNT+1
+21 SET ORY(OCNT)=LIT_$GET(^UTILITY("DIQ1",$JOB,DIC,OREDU,SUB,SUB1))
+22 SET LIT=""
End DoDot:2
End DoDot:1
+23 KILL ^UTILITY("DIQ1",$JOB)
+24 QUIT
+25 ;
EDS(ORY,OREDU) ;return education subtopics
+1 ; ien^name^sub-topic sequence number
+2 ;
+3 NEW DIC,DR,DA,DATA,DIQ,NODE,NULL,OCNT,REF,SUB,TEMP
+4 NEW EDIEN,EDNAME,EDSEQ,EDPNAM
+5 SET NULL=1
SET OCNT=0
+6 KILL ^UTILITY("DIQ1",$JOB)
+7 FOR NODE=1:1
Begin DoDot:1
+8 SET REF=9999999.091001
+9 SET DR=10
+10 SET DA(REF)=NODE
+11 SET DR(REF)=".01;3"
+12 SET DIC=9999999.09
+13 SET DA=OREDU
+14 SET DIQ(0)="EIN"
+15 DO EN^DIQ1
+16 SET EDIEN=$GET(^UTILITY("DIQ1",$JOB,REF,NODE,.01,"I"))
+17 IF EDIEN=""
KILL ^UTILITY("DIQ1",$JOB)
QUIT
+18 SET EDNAME=$GET(^UTILITY("DIQ1",$JOB,REF,NODE,.01,"E"))
+19 SET EDSEQ=$GET(^UTILITY("DIQ1",$JOB,REF,NODE,3,"E"))
if EDSEQ=""
SET EDSEQ=" "
+20 SET EDPNAM=$PIECE($GET(^AUTTEDT(EDIEN,0)),U,4)
+21 SET TEMP(EDSEQ,EDIEN)=EDIEN_U_EDNAME_U_EDPNAM_U_EDSEQ
+22 KILL ^UTILITY("DIQ1",$JOB)
End DoDot:1
if EDIEN=""
QUIT
+23 ;Output array in sequence order
+24 SET EDSEQ=""
+25 FOR
SET EDSEQ=$ORDER(TEMP(EDSEQ))
if EDSEQ=""
QUIT
Begin DoDot:1
+26 SET EDIEN=""
+27 FOR
SET EDIEN=$ORDER(TEMP(EDSEQ,EDIEN))
if EDIEN=""
QUIT
Begin DoDot:2
+28 SET OCNT=OCNT+1
SET ORY(OCNT)=TEMP(EDSEQ,EDIEN)
End DoDot:2
End DoDot:1
+29 QUIT
