- BQIMTCR1 ;GDIT/HS/ALA-Definition Detail results ; 20 Feb 2013 4:48 PM
- ;;2.3;ICARE MANAGEMENT SYSTEM;**3,4**;Apr 18, 2012;Build 66
- ;
- IN(RIEN,FIELD,RESULT) ;EP - Inpatient
- NEW FSPC,NURSE,TFAC
- S RESULT=0
- I FIELD="ADTM"!(FIELD="ATYP")!(FIELD="DIAG") D
- . I $$GET1^DIQ(405,RIEN_",",.02,"E")'="ADMISSION" Q
- . I FIELD="ADTM" S RESULT=1_U_$$GET1^DIQ(405,RIEN_",",.01,"I") Q
- . I FIELD="ATYP" S RESULT=1_U_$$GET1^DIQ(405,RIEN_",",.04,"E") Q
- . I FIELD="DIAG" S RESULT=1_U_$$GET1^DIQ(405,RIEN_",",.1,"E") Q
- I FIELD="DDTM"!(FIELD="DTYP") D
- . S NXN=""
- . F S NXN=$O(^DGPM("CA",RIEN,NXN)) Q:NXN="" D
- .. I $$GET1^DIQ(405,NXN_",",.02,"E")'="DISCHARGE" Q
- .. I FIELD="DDTM" S RESULT=1_U_$$GET1^DIQ(405,NXN_",",.01,"I") Q
- .. I FIELD="DTYP" S RESULT=1_U_$$GET1^DIQ(405,NXN_",",.04,"E") Q
- ;
- I FIELD="APROV" D
- . S NXN=""
- . F S NXN=$O(^DGPM("CA",RIEN,NXN)) Q:NXN="" D
- .. S PROV=$$GET1^DIQ(405,NXN_",",.19,"E") I PROV="" Q
- .. S RESULT=RESULT_PROV_$C(10)_$C(13)
- . S:$E(RESULT,1,1)=0 RESULT=$E(RESULT,2,$L(RESULT))
- . S RESULT=1_U_$$TKO^BQIUL1(RESULT,$C(10)_$C(13))
- I FIELD="WARD" D
- . S NXN=""
- . F S NXN=$O(^DGPM("CA",RIEN,NXN)) Q:NXN="" D
- .. S WARD=$$GET1^DIQ(405,NXN_",",.06,"E") I WARD="" Q
- .. S RESULT=RESULT_WARD_$C(10)_$C(13)
- . S:$E(RESULT,1,1)=0 RESULT=$E(RESULT,2,$L(RESULT))
- . S RESULT=1_U_$$TKO^BQIUL1(RESULT,$C(10)_$C(13))
- I FIELD="TFAC" D
- . S NXN=""
- . F S NXN=$O(^DGPM("CA",RIEN,NXN)) Q:NXN="" D
- .. S TFAC=$$GET1^DIQ(405,NXN_",",.05,"E") I TFAC="" Q
- .. S RESULT=RESULT_TFAC_$C(10)_$C(13)
- . S:$E(RESULT,1,1)=0 RESULT=$E(RESULT,2,$L(RESULT))
- . S RESULT=1_U_$$TKO^BQIUL1(RESULT,$C(10)_$C(13))
- I FIELD="FSPEC" D
- . S NXN=""
- . F S NXN=$O(^DGPM("CA",RIEN,NXN)) Q:NXN="" D
- .. S FSPC=$$GET1^DIQ(405,NXN_",",.09,"E") I FSPC="" Q
- .. S RESULT=RESULT_FSPC_$C(10)_$C(13)
- . S:$E(RESULT,1,1)=0 RESULT=$E(RESULT,2,$L(RESULT))
- . S RESULT=1_U_$$TKO^BQIUL1(RESULT,$C(10)_$C(13))
- ;
- I FIELD="NURSE" D
- . NEW BQIMT
- . S VISIT=$P(^DGPM(RIEN,0),U,27) I VISIT="" Q
- . S TIEN=""
- . F S TIEN=$O(^TIU(8925,"V",VISIT,TIEN)) Q:TIEN="" D
- .. I $$GET1^DIQ(8925,TIEN_",",.01,"E")'["NURSE" Q
- .. S NURSE=$$GET1^DIQ(8925,TIEN_",",1202,"E")
- .. S BQIMT(NURSE)=""
- . S NURSE=""
- . F S NURSE=$O(BQIMT(NURSE)) Q:NURSE="" S RESULT=RESULT_NURSE_$C(10)_$C(13)
- . S:$E(RESULT,1,1)=0 RESULT=$E(RESULT,2,$L(RESULT))
- . S RESULT=1_U_$$TKO^BQIUL1(RESULT,$C(10)_$C(13))
- Q RESULT
- ;
- RM(RIEN,FIELD,RESULT) ; EP - Reminder Notifications
- S RESULT=0
- I FIELD="CODE" D Q RESULT
- . NEW DUE
- . S RN=$O(^BQIPAT(DFN,40,"B",RIEN,"")) Q:RN=""
- . S DUE=$P($G(^BQIPAT(DFN,40,RN,0)),U,4) I DUE="" S DUE=DT
- . S DUE=$$FMTMDY^BQIUL1(DUE)
- . S RESULT=1_U_DUE
- S RN="",RN=$O(^BQI(90509.4,"C",DFN,RIEN,RN),-1) I RN'="" D
- . I FIELD=.04 I $P(^BQI(90509.4,RN,0),U,4)'="" S RESULT=1_U_$P(^BQI(90509.4,RN,0),U,4) Q
- . I FIELD=.05 S RESULT=$$GET1^DIQ(90509.4,RN_",",FIELD,"E") I RESULT'="" S RESULT=1_U_RESULT Q
- . I FIELD=.03 S RESULT=$$GET1^DIQ(90509.4,RN_",",FIELD,"E") I RESULT'="" S RESULT=1_U_RESULT Q
- . I FIELD=.08 S RESULT=$$GET1^DIQ(90509.4,RN_",",FIELD,"E") I RESULT'="" S RESULT=1_U_RESULT Q
- . I FIELD=.11 I $P(^BQI(90509.4,RN,0),U,11)'="" S RESULT=1_U_$P(^BQI(90509.4,RN,0),U,11)
- Q RESULT
- BQIMTCR1 ;GDIT/HS/ALA-Definition Detail results ; 20 Feb 2013 4:48 PM
- +1 ;;2.3;ICARE MANAGEMENT SYSTEM;**3,4**;Apr 18, 2012;Build 66
- +2 ;
- IN(RIEN,FIELD,RESULT) ;EP - Inpatient
- +1 NEW FSPC,NURSE,TFAC
- +2 SET RESULT=0
- +3 IF FIELD="ADTM"!(FIELD="ATYP")!(FIELD="DIAG")
- Begin DoDot:1
- +4 IF $$GET1^DIQ(405,RIEN_",",.02,"E")'="ADMISSION"
- QUIT
- +5 IF FIELD="ADTM"
- SET RESULT=1_U_$$GET1^DIQ(405,RIEN_",",.01,"I")
- QUIT
- +6 IF FIELD="ATYP"
- SET RESULT=1_U_$$GET1^DIQ(405,RIEN_",",.04,"E")
- QUIT
- +7 IF FIELD="DIAG"
- SET RESULT=1_U_$$GET1^DIQ(405,RIEN_",",.1,"E")
- QUIT
- End DoDot:1
- +8 IF FIELD="DDTM"!(FIELD="DTYP")
- Begin DoDot:1
- +9 SET NXN=""
- +10 FOR
- SET NXN=$ORDER(^DGPM("CA",RIEN,NXN))
- IF NXN=""
- QUIT
- Begin DoDot:2
- +11 IF $$GET1^DIQ(405,NXN_",",.02,"E")'="DISCHARGE"
- QUIT
- +12 IF FIELD="DDTM"
- SET RESULT=1_U_$$GET1^DIQ(405,NXN_",",.01,"I")
- QUIT
- +13 IF FIELD="DTYP"
- SET RESULT=1_U_$$GET1^DIQ(405,NXN_",",.04,"E")
- QUIT
- End DoDot:2
- End DoDot:1
- +14 ;
- +15 IF FIELD="APROV"
- Begin DoDot:1
- +16 SET NXN=""
- +17 FOR
- SET NXN=$ORDER(^DGPM("CA",RIEN,NXN))
- IF NXN=""
- QUIT
- Begin DoDot:2
- +18 SET PROV=$$GET1^DIQ(405,NXN_",",.19,"E")
- IF PROV=""
- QUIT
- +19 SET RESULT=RESULT_PROV_$CHAR(10)_$CHAR(13)
- End DoDot:2
- +20 IF $EXTRACT(RESULT,1,1)=0
- SET RESULT=$EXTRACT(RESULT,2,$LENGTH(RESULT))
- +21 SET RESULT=1_U_$$TKO^BQIUL1(RESULT,$CHAR(10)_$CHAR(13))
- End DoDot:1
- +22 IF FIELD="WARD"
- Begin DoDot:1
- +23 SET NXN=""
- +24 FOR
- SET NXN=$ORDER(^DGPM("CA",RIEN,NXN))
- IF NXN=""
- QUIT
- Begin DoDot:2
- +25 SET WARD=$$GET1^DIQ(405,NXN_",",.06,"E")
- IF WARD=""
- QUIT
- +26 SET RESULT=RESULT_WARD_$CHAR(10)_$CHAR(13)
- End DoDot:2
- +27 IF $EXTRACT(RESULT,1,1)=0
- SET RESULT=$EXTRACT(RESULT,2,$LENGTH(RESULT))
- +28 SET RESULT=1_U_$$TKO^BQIUL1(RESULT,$CHAR(10)_$CHAR(13))
- End DoDot:1
- +29 IF FIELD="TFAC"
- Begin DoDot:1
- +30 SET NXN=""
- +31 FOR
- SET NXN=$ORDER(^DGPM("CA",RIEN,NXN))
- IF NXN=""
- QUIT
- Begin DoDot:2
- +32 SET TFAC=$$GET1^DIQ(405,NXN_",",.05,"E")
- IF TFAC=""
- QUIT
- +33 SET RESULT=RESULT_TFAC_$CHAR(10)_$CHAR(13)
- End DoDot:2
- +34 IF $EXTRACT(RESULT,1,1)=0
- SET RESULT=$EXTRACT(RESULT,2,$LENGTH(RESULT))
- +35 SET RESULT=1_U_$$TKO^BQIUL1(RESULT,$CHAR(10)_$CHAR(13))
- End DoDot:1
- +36 IF FIELD="FSPEC"
- Begin DoDot:1
- +37 SET NXN=""
- +38 FOR
- SET NXN=$ORDER(^DGPM("CA",RIEN,NXN))
- IF NXN=""
- QUIT
- Begin DoDot:2
- +39 SET FSPC=$$GET1^DIQ(405,NXN_",",.09,"E")
- IF FSPC=""
- QUIT
- +40 SET RESULT=RESULT_FSPC_$CHAR(10)_$CHAR(13)
- End DoDot:2
- +41 IF $EXTRACT(RESULT,1,1)=0
- SET RESULT=$EXTRACT(RESULT,2,$LENGTH(RESULT))
- +42 SET RESULT=1_U_$$TKO^BQIUL1(RESULT,$CHAR(10)_$CHAR(13))
- End DoDot:1
- +43 ;
- +44 IF FIELD="NURSE"
- Begin DoDot:1
- +45 NEW BQIMT
- +46 SET VISIT=$PIECE(^DGPM(RIEN,0),U,27)
- IF VISIT=""
- QUIT
- +47 SET TIEN=""
- +48 FOR
- SET TIEN=$ORDER(^TIU(8925,"V",VISIT,TIEN))
- IF TIEN=""
- QUIT
- Begin DoDot:2
- +49 IF $$GET1^DIQ(8925,TIEN_",",.01,"E")'["NURSE"
- QUIT
- +50 SET NURSE=$$GET1^DIQ(8925,TIEN_",",1202,"E")
- +51 SET BQIMT(NURSE)=""
- End DoDot:2
- +52 SET NURSE=""
- +53 FOR
- SET NURSE=$ORDER(BQIMT(NURSE))
- IF NURSE=""
- QUIT
- SET RESULT=RESULT_NURSE_$CHAR(10)_$CHAR(13)
- +54 IF $EXTRACT(RESULT,1,1)=0
- SET RESULT=$EXTRACT(RESULT,2,$LENGTH(RESULT))
- +55 SET RESULT=1_U_$$TKO^BQIUL1(RESULT,$CHAR(10)_$CHAR(13))
- End DoDot:1
- +56 QUIT RESULT
- +57 ;
- RM(RIEN,FIELD,RESULT) ; EP - Reminder Notifications
- +1 SET RESULT=0
- +2 IF FIELD="CODE"
- Begin DoDot:1
- +3 NEW DUE
- +4 SET RN=$ORDER(^BQIPAT(DFN,40,"B",RIEN,""))
- IF RN=""
- QUIT
- +5 SET DUE=$PIECE($GET(^BQIPAT(DFN,40,RN,0)),U,4)
- IF DUE=""
- SET DUE=DT
- +6 SET DUE=$$FMTMDY^BQIUL1(DUE)
- +7 SET RESULT=1_U_DUE
- End DoDot:1
- QUIT RESULT
- +8 SET RN=""
- SET RN=$ORDER(^BQI(90509.4,"C",DFN,RIEN,RN),-1)
- IF RN'=""
- Begin DoDot:1
- +9 IF FIELD=.04
- IF $PIECE(^BQI(90509.4,RN,0),U,4)'=""
- SET RESULT=1_U_$PIECE(^BQI(90509.4,RN,0),U,4)
- QUIT
- +10 IF FIELD=.05
- SET RESULT=$$GET1^DIQ(90509.4,RN_",",FIELD,"E")
- IF RESULT'=""
- SET RESULT=1_U_RESULT
- QUIT
- +11 IF FIELD=.03
- SET RESULT=$$GET1^DIQ(90509.4,RN_",",FIELD,"E")
- IF RESULT'=""
- SET RESULT=1_U_RESULT
- QUIT
- +12 IF FIELD=.08
- SET RESULT=$$GET1^DIQ(90509.4,RN_",",FIELD,"E")
- IF RESULT'=""
- SET RESULT=1_U_RESULT
- QUIT
- +13 IF FIELD=.11
- IF $PIECE(^BQI(90509.4,RN,0),U,11)'=""
- SET RESULT=1_U_$PIECE(^BQI(90509.4,RN,0),U,11)
- End DoDot:1
- +14 QUIT RESULT
