- PXBGPED ;ISL/PKR - Gather patient education data. Follow the convention established by PXBGCPT. ;7/24/96 14:00
- ;;1.0;PCE PATIENT CARE ENCOUNTER;;Aug 12, 1996
- ;
- EDU(VISIT) ;Gather the entries in the V Health Factor file.
- N DA,DIC,DIQ,DR,IEN
- ;
- K ^TMP("PXBU",$J)
- I $D(^AUPNVPED("AD",VISIT)) D
- . S IEN=0
- . F S IEN=$O(^AUPNVPED("AD",VISIT,IEN)) Q:IEN'>0 D
- .. S ^TMP("PXBU",$J,"PED",IEN)=""
- ;
- N ENCDT,ENCPRV,PATIENT,PEDA,TEMP,TOPIC,UNDSTD
- I $D(^TMP("PXBU",$J,"PED")) D
- . S IEN=0
- . F S IEN=$O(^TMP("PXBU",$J,"PED",IEN)) Q:IEN'>0 D
- .. K TEMP
- .. S DIC=9000010.16,DA=IEN
- .. S DR=".01;.02;.06;1201;1204;811"
- .. S DIQ="TEMP(",DIQ(0)="E"
- .. D EN^DIQ1
- .. S TOPIC=$G(TEMP(9000010.16,DA,.01,"E"))
- .. S PATIENT=$G(TEMP(9000010.16,DA,.02,"E"))
- .. S UNDSTD=$G(TEMP(9000010.16,DA,.06,"E"))
- .. S ENCDT=$G(TEMP(9000010.16,DA,1201,"E"))
- .. S ENCPRV=$G(TEMP(9000010.16,DA,1204,"E"))
- .. S PEDA(TOPIC,IEN)=TOPIC_U_PATIENT_U_UNDSTD_U_ENCDT_U_ENCPRV
- ;
- N PXBC
- S PXBC=0
- I $D(PEDA) D
- . S TOPIC=""
- . F S TOPIC=$O(PEDA(TOPIC)) Q:TOPIC="" D
- .. S IEN=0
- .. F S IEN=$O(PEDA(TOPIC,IEN)) Q:IEN="" D
- ... S PXBC=PXBC+1
- ... S PXBKY(TOPIC,IEN)=PEDA(TOPIC,IEN)
- ... S PXBSAM(PXBC)=PEDA(TOPIC,IEN)
- ... S PXBSKY(PXBC,IEN)=PEDA(TOPIC,IEN)
- ;
- K ^TMP("PXBU",$J)
- S PXBCNT=PXBC
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXBGPED 1321 printed Feb 18, 2025@23:52:53 Page 2
- PXBGPED ;ISL/PKR - Gather patient education data. Follow the convention established by PXBGCPT. ;7/24/96 14:00
- +1 ;;1.0;PCE PATIENT CARE ENCOUNTER;;Aug 12, 1996
- +2 ;
- EDU(VISIT) ;Gather the entries in the V Health Factor file.
- +1 NEW DA,DIC,DIQ,DR,IEN
- +2 ;
- +3 KILL ^TMP("PXBU",$JOB)
- +4 IF $DATA(^AUPNVPED("AD",VISIT))
- Begin DoDot:1
- +5 SET IEN=0
- +6 FOR
- SET IEN=$ORDER(^AUPNVPED("AD",VISIT,IEN))
- if IEN'>0
- QUIT
- Begin DoDot:2
- +7 SET ^TMP("PXBU",$JOB,"PED",IEN)=""
- End DoDot:2
- End DoDot:1
- +8 ;
- +9 NEW ENCDT,ENCPRV,PATIENT,PEDA,TEMP,TOPIC,UNDSTD
- +10 IF $DATA(^TMP("PXBU",$JOB,"PED"))
- Begin DoDot:1
- +11 SET IEN=0
- +12 FOR
- SET IEN=$ORDER(^TMP("PXBU",$JOB,"PED",IEN))
- if IEN'>0
- QUIT
- Begin DoDot:2
- +13 KILL TEMP
- +14 SET DIC=9000010.16
- SET DA=IEN
- +15 SET DR=".01;.02;.06;1201;1204;811"
- +16 SET DIQ="TEMP("
- SET DIQ(0)="E"
- +17 DO EN^DIQ1
- +18 SET TOPIC=$GET(TEMP(9000010.16,DA,.01,"E"))
- +19 SET PATIENT=$GET(TEMP(9000010.16,DA,.02,"E"))
- +20 SET UNDSTD=$GET(TEMP(9000010.16,DA,.06,"E"))
- +21 SET ENCDT=$GET(TEMP(9000010.16,DA,1201,"E"))
- +22 SET ENCPRV=$GET(TEMP(9000010.16,DA,1204,"E"))
- +23 SET PEDA(TOPIC,IEN)=TOPIC_U_PATIENT_U_UNDSTD_U_ENCDT_U_ENCPRV
- End DoDot:2
- End DoDot:1
- +24 ;
- +25 NEW PXBC
- +26 SET PXBC=0
- +27 IF $DATA(PEDA)
- Begin DoDot:1
- +28 SET TOPIC=""
- +29 FOR
- SET TOPIC=$ORDER(PEDA(TOPIC))
- if TOPIC=""
- QUIT
- Begin DoDot:2
- +30 SET IEN=0
- +31 FOR
- SET IEN=$ORDER(PEDA(TOPIC,IEN))
- if IEN=""
- QUIT
- Begin DoDot:3
- +32 SET PXBC=PXBC+1
- +33 SET PXBKY(TOPIC,IEN)=PEDA(TOPIC,IEN)
- +34 SET PXBSAM(PXBC)=PEDA(TOPIC,IEN)
- +35 SET PXBSKY(PXBC,IEN)=PEDA(TOPIC,IEN)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +36 ;
- +37 KILL ^TMP("PXBU",$JOB)
- +38 SET PXBCNT=PXBC
- +39 QUIT
