- BQIPTREV ;APTIV/HC/ALA-Get Patient's Last Routine Events ; 18 Jan 2008 5:49 PM
- ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
- ;
- ;
- EN(DATA,DFN) ;EP - BQI GET PATIENT ROUTINE EVENTS
- ;Description - all the routine events that a patient has
- ;
- ;Input
- ; DFN - Patient internal entry number
- ;
- NEW UID,II,BQNM,IEN,BQEVNT,HIEN,CALL,TAG,CODE,BQREM,RIEN,BQIX,BQLDT,CAT
- S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
- S DATA=$NA(^TMP("BQIPTREV",UID))
- K @DATA
- ;
- S II=0
- NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPTREV D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
- ;
- S HDR="T00050LASTROUT^D00015LASTDATE^T00030CATEGORY^I00010VISIT_IEN"
- S @DATA@(II)=HDR_$C(30)
- S BQNM=""
- F S BQNM=$O(^BQI(90507.3,"B",BQNM)) Q:BQNM="" D
- . S IEN=""
- . F S IEN=$O(^BQI(90507.3,"B",BQNM,IEN)) Q:IEN="" D
- .. S BQEVNT=$P(^BQI(90507.3,IEN,0),U,1),BQREM=$P(^(0),U,2)
- .. S HIEN=$$FIND1^DIC(9001018,"","X",BQREM,"B","","ERROR")
- .. ; if it didn't find the corresponding reminder, quit
- .. I HIEN=0 Q
- .. I $P(^APCHSURV(HIEN,0),U,3)'=1 Q
- .. S CALL=$P(^APCHSURV(HIEN,0),U,2),TAG=$P(CALL,";",1)
- .. S CAT=$$GET1^DIQ(9001018,HIEN_",",.05,"E")
- .. I TAG="" Q
- .. S CODE=TAG_"_"_HIEN
- .. S RIEN=$O(^BQIPAT(DFN,40,"B",CODE,""))
- .. I RIEN="" Q
- .. S BQIX=^BQIPAT(DFN,40,RIEN,0)
- .. S CT=0 F BI=2:1:3 I $P(BQIX,U,BI)'="" S CT=CT+1
- .. I CT=0 Q
- .. S BQLDT=$P(BQIX,U,2),VISIT=$P(BQIX,U,6)
- .. ;
- .. I BQREM="COLORECTAL CA-SCOPE/XRAY" D
- ... S BQLDT=""
- ... S X=$$GVHMR^APCHSMU(DFN,HIEN)
- ... I X'["|" S BQVAL=$P(X,U,4) D Q
- .... I BQVAL'[$$UP^XLFSTR(BQEVNT) Q
- .... S BQLDT=$P(X,U,2),VISIT=$P(X,U,6)
- ... F BQJ=1:1:$L(X,"|") D
- .... S BQVAL=$P(X,"|",BQJ)
- .... I $P(BQVAL,U,1)'=$$UP^XLFSTR(BQEVNT) Q
- .... S BQLDT=$P(BQVAL,U,2),VISIT=$P(BQIX,U,6)
- .. S BQLDT=$$FMTE^BQIUL1(BQLDT)
- .. ;I BQLDT="" S BQLDT="01/01/0001 12:00:00 AM"
- .. S II=II+1,@DATA@(II)=BQEVNT_U_BQLDT_U_CAT_U_VISIT_$C(30)
- ;
- 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
- BQIPTREV ;APTIV/HC/ALA-Get Patient's Last Routine Events ; 18 Jan 2008 5:49 PM
- +1 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
- +2 ;
- +3 ;
- EN(DATA,DFN) ;EP - BQI GET PATIENT ROUTINE EVENTS
- +1 ;Description - all the routine events that a patient has
- +2 ;
- +3 ;Input
- +4 ; DFN - Patient internal entry number
- +5 ;
- +6 NEW UID,II,BQNM,IEN,BQEVNT,HIEN,CALL,TAG,CODE,BQREM,RIEN,BQIX,BQLDT,CAT
- +7 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
- +8 SET DATA=$NAME(^TMP("BQIPTREV",UID))
- +9 KILL @DATA
- +10 ;
- +11 SET II=0
- +12 ; SAC 2006 2.2.3.3.2
- NEW $ESTACK,$ETRAP
- SET $ETRAP="D ERR^BQIPTREV D UNWIND^%ZTER"
- +13 ;
- +14 SET HDR="T00050LASTROUT^D00015LASTDATE^T00030CATEGORY^I00010VISIT_IEN"
- +15 SET @DATA@(II)=HDR_$CHAR(30)
- +16 SET BQNM=""
- +17 FOR
- SET BQNM=$ORDER(^BQI(90507.3,"B",BQNM))
- IF BQNM=""
- QUIT
- Begin DoDot:1
- +18 SET IEN=""
- +19 FOR
- SET IEN=$ORDER(^BQI(90507.3,"B",BQNM,IEN))
- IF IEN=""
- QUIT
- Begin DoDot:2
- +20 SET BQEVNT=$PIECE(^BQI(90507.3,IEN,0),U,1)
- SET BQREM=$PIECE(^(0),U,2)
- +21 SET HIEN=$$FIND1^DIC(9001018,"","X",BQREM,"B","","ERROR")
- +22 ; if it didn't find the corresponding reminder, quit
- +23 IF HIEN=0
- QUIT
- +24 IF $PIECE(^APCHSURV(HIEN,0),U,3)'=1
- QUIT
- +25 SET CALL=$PIECE(^APCHSURV(HIEN,0),U,2)
- SET TAG=$PIECE(CALL,";",1)
- +26 SET CAT=$$GET1^DIQ(9001018,HIEN_",",.05,"E")
- +27 IF TAG=""
- QUIT
- +28 SET CODE=TAG_"_"_HIEN
- +29 SET RIEN=$ORDER(^BQIPAT(DFN,40,"B",CODE,""))
- +30 IF RIEN=""
- QUIT
- +31 SET BQIX=^BQIPAT(DFN,40,RIEN,0)
- +32 SET CT=0
- FOR BI=2:1:3
- IF $PIECE(BQIX,U,BI)'=""
- SET CT=CT+1
- +33 IF CT=0
- QUIT
- +34 SET BQLDT=$PIECE(BQIX,U,2)
- SET VISIT=$PIECE(BQIX,U,6)
- +35 ;
- +36 IF BQREM="COLORECTAL CA-SCOPE/XRAY"
- Begin DoDot:3
- +37 SET BQLDT=""
- +38 SET X=$$GVHMR^APCHSMU(DFN,HIEN)
- +39 IF X'["|"
- SET BQVAL=$PIECE(X,U,4)
- Begin DoDot:4
- +40 IF BQVAL'[$$UP^XLFSTR(BQEVNT)
- QUIT
- +41 SET BQLDT=$PIECE(X,U,2)
- SET VISIT=$PIECE(X,U,6)
- End DoDot:4
- QUIT
- +42 FOR BQJ=1:1:$LENGTH(X,"|")
- Begin DoDot:4
- +43 SET BQVAL=$PIECE(X,"|",BQJ)
- +44 IF $PIECE(BQVAL,U,1)'=$$UP^XLFSTR(BQEVNT)
- QUIT
- +45 SET BQLDT=$PIECE(BQVAL,U,2)
- SET VISIT=$PIECE(BQIX,U,6)
- End DoDot:4
- End DoDot:3
- +46 SET BQLDT=$$FMTE^BQIUL1(BQLDT)
- +47 ;I BQLDT="" S BQLDT="01/01/0001 12:00:00 AM"
- +48 SET II=II+1
- SET @DATA@(II)=BQEVNT_U_BQLDT_U_CAT_U_VISIT_$CHAR(30)
- End DoDot:2
- End DoDot:1
- +49 ;
- +50 SET II=II+1
- SET @DATA@(II)=$CHAR(31)
- +51 QUIT
- +52 ;
- 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
