- BQIPTED ;PRXM/HC/ALA-Patient Education ; 23 Feb 2007 4:55 PM
- ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
- ;
- Q
- ;
- EDU(DATA,DFN,DRANGE) ; EP -- BQI PATIENT EDUCATION
- ;
- ;Description - all the education that a patient has
- ;
- ;Input
- ; DFN - Patient internal entry number
- ;
- NEW UID,II,IEN,TOPIC,VISIT,VSDTM,LEVEL,OPROV,EPROV,LENGTH,IG,COMM,PROV
- S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
- S DATA=$NA(^TMP("BQIPTED",UID))
- K @DATA
- ;
- S II=0
- NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPTED D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
- ;
- S DRANGE=$$DATE^BQIUL1($G(DRANGE))
- S @DATA@(II)="I00010EDUC_IEN^I00010VISIT_IEN^D00030VISIT_DATETIME^T00050TOPIC^I00003LENGTH^T00035PROVIDER^T00012STATUS^T00030LEVEL^T00001IG^T00100COMMENT"_$C(30)
- S IEN=""
- F S IEN=$O(^AUPNVPED("AC",DFN,IEN),-1) Q:IEN="" D
- . S TOPIC=$$GET1^DIQ(9000010.16,IEN_",",.01,"E") I TOPIC="" Q
- . S VISIT=$$GET1^DIQ(9000010.16,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 LEVEL=$$GET1^DIQ(9000010.16,IEN_",",.06,"E")
- . S LENGTH=$$GET1^DIQ(9000010.16,IEN_",",.08,"E")
- . S IG=$$GET1^DIQ(9000010.16,IEN_",",.07,"I")
- . S OPROV=$$GET1^DIQ(9000010.16,IEN_",",1202,"E")
- . S COMM=$$GET1^DIQ(9000010.16,IEN_",",.11,"E")
- . S STAT=$$GET1^DIQ(9000010.16,IEN_",",.13,"E")
- . S EPROV=$$GET1^DIQ(9000010.16,IEN_",",1204,"E")
- . S PROV=$$GET1^DIQ(9000010.16,IEN_",",.05,"E")
- . S II=II+1,@DATA@(II)=IEN_U_VISIT_U_$$FMTE^BQIUL1(VSDTM)_U_TOPIC_U_LENGTH_U_PROV_U_STAT_U_LEVEL_U_IG_U_COMM_$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,TOPIC,RSLT,ORPHY,STAT,LEVEL,IG,COMM
- S TOP=""
- F S TOP=$O(^AUPNPREF("AA",DFN,9999999.09,TOP)) Q:TOP="" D
- . S RVDT=""
- . F S RVDT=$O(^AUPNPREF("AA",DFN,9999999.09,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,9999999.09,TOP,RVDT,RFIEN)) Q:RFIEN="" D
- ... S TOPIC=$$GET1^DIQ(9999999.09,TOP_",",.01,"E")
- ... S RSLT=$$GET1^DIQ(9000022,RFIEN_",",.07,"E")
- ... S ORPHY=$$GET1^DIQ(9000022,RFIEN_",",1204,"E")
- ... S STAT="",IG="",COMM="",LENGTH=""
- ... S II=II+1,@DATA@(II)=U_U_$$FMTE^BQIUL1(REVDT)_U_TOPIC_U_LENGTH_U_ORPHY_U_STAT_U_RSLT_U_IG_U_COMM_$C(30)
- Q
- BQIPTED ;PRXM/HC/ALA-Patient Education ; 23 Feb 2007 4:55 PM
- +1 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
- +2 ;
- +3 QUIT
- +4 ;
- EDU(DATA,DFN,DRANGE) ; EP -- BQI PATIENT EDUCATION
- +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,TOPIC,VISIT,VSDTM,LEVEL,OPROV,EPROV,LENGTH,IG,COMM,PROV
- +8 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
- +9 SET DATA=$NAME(^TMP("BQIPTED",UID))
- +10 KILL @DATA
- +11 ;
- +12 SET II=0
- +13 ; SAC 2006 2.2.3.3.2
- NEW $ESTACK,$ETRAP
- SET $ETRAP="D ERR^BQIPTED D UNWIND^%ZTER"
- +14 ;
- +15 SET DRANGE=$$DATE^BQIUL1($GET(DRANGE))
- +16 SET @DATA@(II)="I00010EDUC_IEN^I00010VISIT_IEN^D00030VISIT_DATETIME^T00050TOPIC^I00003LENGTH^T00035PROVIDER^T00012STATUS^T00030LEVEL^T00001IG^T00100COMMENT"_$CHAR(30)
- +17 SET IEN=""
- +18 FOR
- SET IEN=$ORDER(^AUPNVPED("AC",DFN,IEN),-1)
- IF IEN=""
- QUIT
- Begin DoDot:1
- +19 SET TOPIC=$$GET1^DIQ(9000010.16,IEN_",",.01,"E")
- IF TOPIC=""
- QUIT
- +20 SET VISIT=$$GET1^DIQ(9000010.16,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 LEVEL=$$GET1^DIQ(9000010.16,IEN_",",.06,"E")
- +24 SET LENGTH=$$GET1^DIQ(9000010.16,IEN_",",.08,"E")
- +25 SET IG=$$GET1^DIQ(9000010.16,IEN_",",.07,"I")
- +26 SET OPROV=$$GET1^DIQ(9000010.16,IEN_",",1202,"E")
- +27 SET COMM=$$GET1^DIQ(9000010.16,IEN_",",.11,"E")
- +28 SET STAT=$$GET1^DIQ(9000010.16,IEN_",",.13,"E")
- +29 SET EPROV=$$GET1^DIQ(9000010.16,IEN_",",1204,"E")
- +30 SET PROV=$$GET1^DIQ(9000010.16,IEN_",",.05,"E")
- +31 SET II=II+1
- SET @DATA@(II)=IEN_U_VISIT_U_$$FMTE^BQIUL1(VSDTM)_U_TOPIC_U_LENGTH_U_PROV_U_STAT_U_LEVEL_U_IG_U_COMM_$CHAR(30)
- End DoDot:1
- +32 ;
- +33 ; Check for refusals
- +34 DO REF
- +35 ;
- +36 SET II=II+1
- SET @DATA@(II)=$CHAR(31)
- +37 QUIT
- +38 ;
- 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,TOPIC,RSLT,ORPHY,STAT,LEVEL,IG,COMM
- +2 SET TOP=""
- +3 FOR
- SET TOP=$ORDER(^AUPNPREF("AA",DFN,9999999.09,TOP))
- IF TOP=""
- QUIT
- Begin DoDot:1
- +4 SET RVDT=""
- +5 FOR
- SET RVDT=$ORDER(^AUPNPREF("AA",DFN,9999999.09,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,9999999.09,TOP,RVDT,RFIEN))
- IF RFIEN=""
- QUIT
- Begin DoDot:3
- +11 SET TOPIC=$$GET1^DIQ(9999999.09,TOP_",",.01,"E")
- +12 SET RSLT=$$GET1^DIQ(9000022,RFIEN_",",.07,"E")
- +13 SET ORPHY=$$GET1^DIQ(9000022,RFIEN_",",1204,"E")
- +14 SET STAT=""
- SET IG=""
- SET COMM=""
- SET LENGTH=""
- +15 SET II=II+1
- SET @DATA@(II)=U_U_$$FMTE^BQIUL1(REVDT)_U_TOPIC_U_LENGTH_U_ORPHY_U_STAT_U_RSLT_U_IG_U_COMM_$CHAR(30)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +16 QUIT
