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
