- BQIPTCPT ;VNGT/HS/ALA-Patient CPT data ; 10 Dec 2008 11:48 AM
- ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
- ;
- Q
- ;
- EN(DATA,DFN,DRANGE) ; EP -- BQI PATIENT CPTS
- ;
- ;Description - all the education that a patient has
- ;
- ;Input
- ; DFN - Patient internal entry number
- ;
- NEW UID,II,IEN
- S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
- S DATA=$NA(^TMP("BQIPTCPT",UID))
- K @DATA
- ;
- S II=0
- NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPTCPT D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
- ;
- S DRANGE=$$DATE^BQIUL1($G(DRANGE))
- S @DATA@(II)="I00010CPT_IEN^I00010VISIT_IEN^D00030VISIT_DATETIME^T00050APCDTCPT^T00025APCDTM1^T00015APCDTM2^T00005APCDTUN"_$C(30)
- S IEN=""
- F S IEN=$O(^AUPNVCPT("AC",DFN,IEN),-1) Q:IEN="" D
- . S CPTN=$$GET1^DIQ(9000010.18,IEN_",",.01,"I") I CPTN="" Q
- . S CPT=$$GET1^DIQ(81,CPTN_",",.01,"E")_" - "_$$GET1^DIQ(81,CPTN_",",2,"E")
- . S VISIT=$$GET1^DIQ(9000010.18,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 MOD1=$$GET1^DIQ(9000010.18,IEN_",",.08,"E")
- . S MOD2=$$GET1^DIQ(9000010.18,IEN_",",.09,"E")
- . S QTY=$$GET1^DIQ(9000010.18,IEN_",",.16,"E")
- . S II=II+1,@DATA@(II)=IEN_U_VISIT_U_$$FMTE^BQIUL1(VSDTM)_U_CPT_U_MOD1_U_MOD2_U_QTY_$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 TOP,RVDT,REVDT,RFIEN,CPT,MOD1,MOD2,QTY,CPTN
- S TOP=""
- F S TOP=$O(^AUPNPREF("AA",DFN,81,TOP)) Q:TOP="" D
- . S RVDT=""
- . F S RVDT=$O(^AUPNPREF("AA",DFN,81,TOP,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,81,TOP,RVDT,RFIEN)) Q:RFIEN="" D
- ... S CPTN=$$GET1^DIQ(9000022,RFIEN_",",.06,"I")
- ... S CPT=$$GET1^DIQ(81,CPTN_",",.01,"E")_" - "_$$GET1^DIQ(81,CPTN_",",2,"E")
- ... S RSLT=$$GET1^DIQ(9000022,RFIEN_",",.07,"E")
- ... S MOD2="",QTY=""
- ... S II=II+1,@DATA@(II)=U_U_$$FMTE^BQIUL1(REVDT)_U_CPT_U_RSLT_U_MOD2_U_QTY_$C(30)
- Q
- BQIPTCPT ;VNGT/HS/ALA-Patient CPT data ; 10 Dec 2008 11:48 AM
- +1 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
- +2 ;
- +3 QUIT
- +4 ;
- EN(DATA,DFN,DRANGE) ; EP -- BQI PATIENT CPTS
- +1 ;
- +2 ;Description - all the education that a patient has
- +3 ;
- +4 ;Input
- +5 ; DFN - Patient internal entry number
- +6 ;
- +7 NEW UID,II,IEN
- +8 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
- +9 SET DATA=$NAME(^TMP("BQIPTCPT",UID))
- +10 KILL @DATA
- +11 ;
- +12 SET II=0
- +13 ; SAC 2006 2.2.3.3.2
- NEW $ESTACK,$ETRAP
- SET $ETRAP="D ERR^BQIPTCPT D UNWIND^%ZTER"
- +14 ;
- +15 SET DRANGE=$$DATE^BQIUL1($GET(DRANGE))
- +16 SET @DATA@(II)="I00010CPT_IEN^I00010VISIT_IEN^D00030VISIT_DATETIME^T00050APCDTCPT^T00025APCDTM1^T00015APCDTM2^T00005APCDTUN"_$CHAR(30)
- +17 SET IEN=""
- +18 FOR
- SET IEN=$ORDER(^AUPNVCPT("AC",DFN,IEN),-1)
- IF IEN=""
- QUIT
- Begin DoDot:1
- +19 SET CPTN=$$GET1^DIQ(9000010.18,IEN_",",.01,"I")
- IF CPTN=""
- QUIT
- +20 SET CPT=$$GET1^DIQ(81,CPTN_",",.01,"E")_" - "_$$GET1^DIQ(81,CPTN_",",2,"E")
- +21 SET VISIT=$$GET1^DIQ(9000010.18,IEN_",",.03,"I")
- IF VISIT=""
- QUIT
- +22 SET VSDTM=$$GET1^DIQ(9000010,VISIT_",",.01,"I")
- IF VSDTM=0
- QUIT
- +23 IF DRANGE'=""
- IF (VSDTM\1<DRANGE)
- QUIT
- +24 SET MOD1=$$GET1^DIQ(9000010.18,IEN_",",.08,"E")
- +25 SET MOD2=$$GET1^DIQ(9000010.18,IEN_",",.09,"E")
- +26 SET QTY=$$GET1^DIQ(9000010.18,IEN_",",.16,"E")
- +27 SET II=II+1
- SET @DATA@(II)=IEN_U_VISIT_U_$$FMTE^BQIUL1(VSDTM)_U_CPT_U_MOD1_U_MOD2_U_QTY_$CHAR(30)
- End DoDot:1
- +28 ;
- +29 ; Check for refusals
- +30 DO REF
- +31 ;
- +32 SET II=II+1
- SET @DATA@(II)=$CHAR(31)
- +33 QUIT
- +34 ;
- 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 TOP,RVDT,REVDT,RFIEN,CPT,MOD1,MOD2,QTY,CPTN
- +2 SET TOP=""
- +3 FOR
- SET TOP=$ORDER(^AUPNPREF("AA",DFN,81,TOP))
- IF TOP=""
- QUIT
- Begin DoDot:1
- +4 SET RVDT=""
- +5 FOR
- SET RVDT=$ORDER(^AUPNPREF("AA",DFN,81,TOP,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,81,TOP,RVDT,RFIEN))
- IF RFIEN=""
- QUIT
- Begin DoDot:3
- +11 SET CPTN=$$GET1^DIQ(9000022,RFIEN_",",.06,"I")
- +12 SET CPT=$$GET1^DIQ(81,CPTN_",",.01,"E")_" - "_$$GET1^DIQ(81,CPTN_",",2,"E")
- +13 SET RSLT=$$GET1^DIQ(9000022,RFIEN_",",.07,"E")
- +14 SET MOD2=""
- SET QTY=""
- +15 SET II=II+1
- SET @DATA@(II)=U_U_$$FMTE^BQIUL1(REVDT)_U_CPT_U_RSLT_U_MOD2_U_QTY_$CHAR(30)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +16 QUIT