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