- BQIPTSKN ;PRXM/HC/ALA - PATIENT SKIN TESTS ; 26 Mar 2007 4:14 PM
- ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
- ;
- Q
- ;
- SK(DATA,DFN,DRANGE) ; EP -- BQI PATIENT SKIN TESTS
- ;
- ;Description - all the skin tests that a patient has
- ;
- ;Input
- ; DFN - Patient internal entry number
- ;
- NEW UID,II,IEN,VISIT,VSDTM,SK,RESULTS,READ,RDTM,INJS,ORPHY,ENPHY
- S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
- S DATA=$NA(^TMP("BQIPTSKN",UID))
- K @DATA
- ;
- S II=0
- NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPTSKN D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
- ;
- S DRANGE=$$DATE^BQIUL1($G(DRANGE))
- S @DATA@(II)="I00010VISIT_IEN^D00030VISIT_DATETIME^T00040SKIN_TEST^T00020RESULTS^T00040READING^D00030READ_DATETIME"_$C(30)
- S IEN=""
- F S IEN=$O(^AUPNVSK("AC",DFN,IEN),-1) Q:IEN="" D
- . S SK=$$GET1^DIQ(9000010.12,IEN_",",.01,"E") I SK="" Q
- . S VISIT=$$GET1^DIQ(9000010.12,IEN_",",.03,"I") I VISIT="" Q
- . S VSDTM=$$GET1^DIQ(9000010,VISIT_",",.01,"I") I VSDTM=0 Q
- . I DRANGE'="",(VSDTM\1<DRANGE) Q
- . S RESULTS=$$GET1^DIQ(9000010.12,IEN_",",.04,"E")
- . S READ=$$GET1^DIQ(9000010.12,IEN_",",.05,"E")
- . S RDTM=$$GET1^DIQ(9000010.12,IEN_",",.06,"I")
- . S INJS=$$GET1^DIQ(9000010.12,IEN_",",.09,"E")
- . ;S ORPHY=$$GET1^DIQ(9000010.12,IEN_",",1202,"E")
- . ;S ENPHY=$$GET1^DIQ(9000010.12,IEN_",",1204,"E")
- . S II=II+1,@DATA@(II)=VISIT_U_$$FMTE^BQIUL1(VSDTM)_U_SK_U_RESULTS_U_READ_U_$$FMTE^BQIUL1(RDTM)_$C(30)
- ;
- ; Check for refusals
- D REF
- S II=II+1,@DATA@(II)=$C(31)
- Q
- ;
- ERR ;
- D ^%ZTER
- NEW Y,ERRDTM
- S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
- S BMXSEC="Recording that an error occurred at "_ERRDTM
- I $D(II),$D(DATA) S II=II+1,@DATA@(II)=$C(31)
- Q
- ;
- REF ; Check for refusals
- NEW SKN,RVDT,REVDT,RFIEN,VISIT,PERCNT,SK,RESULTS
- S SKN=""
- F S SKN=$O(^AUPNPREF("AA",DFN,9999999.28,SKN)) Q:SKN="" D
- . S RVDT=""
- . F S RVDT=$O(^AUPNPREF("AA",DFN,9999999.28,SKN,RVDT)) Q:RVDT="" D
- .. ; Reverse the reverse date
- .. S REVDT=9999999-RVDT
- .. I DRANGE'="",(REVDT\1)<DRANGE Q
- .. S RFIEN=""
- .. F S RFIEN=$O(^AUPNPREF("AA",DFN,9999999.28,SKN,RVDT,RFIEN)) Q:RFIEN="" D
- ... S SK=$$GET1^DIQ(9999999.28,SKN_",",.01,"E")
- ... S RESULTS=$$GET1^DIQ(9000022,RFIEN_",",.07,"E")
- ... S ORPHY=$$GET1^DIQ(9000022,RFIEN_",",1204,"E")
- ... S READ="",VISIT="",RDTM=""
- ... S II=II+1,@DATA@(II)=VISIT_U_$$FMTE^BQIUL1(REVDT)_U_SK_U_RESULTS_U_READ_U_RDTM_$C(30)
- Q
- BQIPTSKN ;PRXM/HC/ALA - PATIENT SKIN TESTS ; 26 Mar 2007 4:14 PM
- +1 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
- +2 ;
- +3 QUIT
- +4 ;
- SK(DATA,DFN,DRANGE) ; EP -- BQI PATIENT SKIN TESTS
- +1 ;
- +2 ;Description - all the skin tests that a patient has
- +3 ;
- +4 ;Input
- +5 ; DFN - Patient internal entry number
- +6 ;
- +7 NEW UID,II,IEN,VISIT,VSDTM,SK,RESULTS,READ,RDTM,INJS,ORPHY,ENPHY
- +8 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
- +9 SET DATA=$NAME(^TMP("BQIPTSKN",UID))
- +10 KILL @DATA
- +11 ;
- +12 SET II=0
- +13 ; SAC 2006 2.2.3.3.2
- NEW $ESTACK,$ETRAP
- SET $ETRAP="D ERR^BQIPTSKN D UNWIND^%ZTER"
- +14 ;
- +15 SET DRANGE=$$DATE^BQIUL1($GET(DRANGE))
- +16 SET @DATA@(II)="I00010VISIT_IEN^D00030VISIT_DATETIME^T00040SKIN_TEST^T00020RESULTS^T00040READING^D00030READ_DATETIME"_$CHAR(30)
- +17 SET IEN=""
- +18 FOR
- SET IEN=$ORDER(^AUPNVSK("AC",DFN,IEN),-1)
- IF IEN=""
- QUIT
- Begin DoDot:1
- +19 SET SK=$$GET1^DIQ(9000010.12,IEN_",",.01,"E")
- IF SK=""
- QUIT
- +20 SET VISIT=$$GET1^DIQ(9000010.12,IEN_",",.03,"I")
- IF VISIT=""
- QUIT
- +21 SET VSDTM=$$GET1^DIQ(9000010,VISIT_",",.01,"I")
- IF VSDTM=0
- QUIT
- +22 IF DRANGE'=""
- IF (VSDTM\1<DRANGE)
- QUIT
- +23 SET RESULTS=$$GET1^DIQ(9000010.12,IEN_",",.04,"E")
- +24 SET READ=$$GET1^DIQ(9000010.12,IEN_",",.05,"E")
- +25 SET RDTM=$$GET1^DIQ(9000010.12,IEN_",",.06,"I")
- +26 SET INJS=$$GET1^DIQ(9000010.12,IEN_",",.09,"E")
- +27 ;S ORPHY=$$GET1^DIQ(9000010.12,IEN_",",1202,"E")
- +28 ;S ENPHY=$$GET1^DIQ(9000010.12,IEN_",",1204,"E")
- +29 SET II=II+1
- SET @DATA@(II)=VISIT_U_$$FMTE^BQIUL1(VSDTM)_U_SK_U_RESULTS_U_READ_U_$$FMTE^BQIUL1(RDTM)_$CHAR(30)
- End DoDot:1
- +30 ;
- +31 ; Check for refusals
- +32 DO REF
- +33 SET II=II+1
- SET @DATA@(II)=$CHAR(31)
- +34 QUIT
- +35 ;
- ERR ;
- +1 DO ^%ZTER
- +2 NEW Y,ERRDTM
- +3 SET Y=$$NOW^XLFDT()
- XECUTE ^DD("DD")
- SET ERRDTM=Y
- +4 SET BMXSEC="Recording that an error occurred at "_ERRDTM
- +5 IF $DATA(II)
- IF $DATA(DATA)
- SET II=II+1
- SET @DATA@(II)=$CHAR(31)
- +6 QUIT
- +7 ;
- REF ; Check for refusals
- +1 NEW SKN,RVDT,REVDT,RFIEN,VISIT,PERCNT,SK,RESULTS
- +2 SET SKN=""
- +3 FOR
- SET SKN=$ORDER(^AUPNPREF("AA",DFN,9999999.28,SKN))
- IF SKN=""
- QUIT
- Begin DoDot:1
- +4 SET RVDT=""
- +5 FOR
- SET RVDT=$ORDER(^AUPNPREF("AA",DFN,9999999.28,SKN,RVDT))
- IF RVDT=""
- QUIT
- Begin DoDot:2
- +6 ; Reverse the reverse date
- +7 SET REVDT=9999999-RVDT
- +8 IF DRANGE'=""
- IF (REVDT\1)<DRANGE
- QUIT
- +9 SET RFIEN=""
- +10 FOR
- SET RFIEN=$ORDER(^AUPNPREF("AA",DFN,9999999.28,SKN,RVDT,RFIEN))
- IF RFIEN=""
- QUIT
- Begin DoDot:3
- +11 SET SK=$$GET1^DIQ(9999999.28,SKN_",",.01,"E")
- +12 SET RESULTS=$$GET1^DIQ(9000022,RFIEN_",",.07,"E")
- +13 SET ORPHY=$$GET1^DIQ(9000022,RFIEN_",",1204,"E")
- +14 SET READ=""
- SET VISIT=""
- SET RDTM=""
- +15 SET II=II+1
- SET @DATA@(II)=VISIT_U_$$FMTE^BQIUL1(REVDT)_U_SK_U_RESULTS_U_READ_U_RDTM_$CHAR(30)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +16 QUIT
