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