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
