- 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 Feb 18, 2025@23:15:17 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