BEHOCIR ;MSC/IND/MGH - CCD calls ;03-Dec-2013 13:37;du
;;1.1;BEH COMPONENTS;**066001**;March 12, 2008;Build 1
;=================================================================
;Set entry into the CCD
;The date/time and user will be associated with all the items in the list
;Input DATA=IEN of reconciliation entry [1]^ DFN [2] ^ BY [3] ^ IMAGE [4] ^ Source [5]^ Allergy date/time [6] ^ Problem dt/time [7] ^ Medication dt/time [8]
; List(n)=Type [1] ^ Item [2]
SET(RET,DATA,LIST) ;EP
N BY,NEW,IEN,IENS,FDA,FNUM,BY,SRC,AREC,PREC,MREC,CNT,WHEN
S RET="",NEW=""
S IEN=""
D TOP(.RET,DATA)
Q:+RET=-1
S CNT="" F S CNT=$O(LIST(CNT)) Q:CNT="" D
.D ITEM(IEN,BY)
;Update the dates of the pieces
S FNUM=90461.63
S IENS=IEN_","
S FDA=$NA(FDA(FNUM,IENS))
S @FDA@(.07)=AREC
S @FDA@(.08)=PREC
S @FDA@(.09)=MREC
D FILE^DIE("E","FDA","ERR")
I $D(ERR("DIERR")) S RET=ERR("DIERR")
I (AREC'="")&(PREC'="")&(MREC'="") D FINISH(IEN)
S RET=IEN
Q
TOP(RET,DATA) ;Get the top entry data and store it
N FNUM,FDA,IENS,ERR,IEN2,DFN,IMG
S IEN=$P(DATA,U,1)
I IEN="" S NEW=1
S DFN=$P(DATA,U,2)
I DFN="" S RET="-1^No patient identified" Q
S BY=$P(DATA,U,3)
I BY="" S BY=$$GET1^DIQ(200,DUZ,.01)
S IMG=$P(DATA,U,4)
;I IMG="" S RET="-1^No CCDA identified" Q
S SRC=$P(DATA,U,5)
S AREC=$P(DATA,U,6)
S PREC=$P(DATA,U,7)
S MREC=$P(DATA,U,8)
S FNUM=90461.63
S IENS=$S('NEW:IEN_",",1:"+1,")
S FDA=$NA(FDA(FNUM,IENS))
S:NEW @FDA@(.01)=$$NOW^XLFDT
S:NEW @FDA@(.02)=DFN
S @FDA@(.03)=SRC
S @FDA@(.05)=BY
S @FDA@(1.1)=IMG
I NEW D
.D UPDATE^DIE("","FDA","IEN2","ERR")
.I $D(ERR) S RET="-1^Unable to add reconcillation data"
.E S IEN=IEN2(1)
E D
.D FILE^DIE("E","FDA","ERR")
.I $D(ERR("DIERR")) S RET=ERR("DIERR")
Q
ITEM(IEN,BY) ;Store each item
N FDA,DIERR,TYPE,AIEN,IENS,ERR,TIEN
Q:IEN=""
S TYPE=$P(LIST(CNT),U,1)
S TIEN=$P(LIST(CNT),U,2)
S AIEN="+1,"_IEN_","
S FDA=$NA(FDA(90461.632,AIEN))
S @FDA@(.01)=$S(TYPE="A":AREC,TYPE="CA":AREC,TYPE="P":PREC,TYPE="CP":PREC,1:MREC)
S @FDA@(.02)=DUZ
S @FDA@(.03)=TYPE
I TYPE["C" S @FDA@(.05)=TIEN
E S @FDA@(.04)=+TIEN
I AREC'="" S @FDA@(.07)=AREC
I PREC'="" S @FDA@(.08)=PREC
I MREC'="" S @FDA@(.09)=MREC
D UPDATE^DIE("","FDA","IENS","ERR")
S:$G(DIERR) RET=-ERR("DIERR",1)_U_ERR("DIERR",1,"TEXT",1)
Q
FINISH(IEN) ;Mark it reconciled
N FDA,ERR
S FDA=$NA(FDA(90461.63,IEN))
S @FDA@(.04)=1
D UPDATE^DIE("","FDA","","ERR")
Q
;Get latest reconcilations for a CCDA
;Input=Image IEN
;Ouput=Alg date[1] ^ Prob date [2] ^ med date[3] ^ NEW ien [4]
GETCIR(RET,IMAGE) ;Get the reconciliations for a CCDS
N INVA,IEN,FIELD,IDATE,ADATE,PDATE,MDATE,NEW,I
S (ADATE,PDATE,MDATE,NEW)=""
S RET=""
F I="AE","AF","AG" D
.S INVA="" S INVA=$O(^BEHOCIR(I,IMAGE,INVA)) Q:INVA="" D
..S IEN="" S IEN=$O(^BEHOCIR(I,IMAGE,INVA,IEN)) Q:IEN="" D
...S FIELD=$S(I="AE":.07,I="AF":.08,I="AG":.09)
...S IDATE=$$GET1^DIQ(90461.63,IEN,FIELD)
...I I="AE" S ADATE=IDATE
...I I="AF" S PDATE=IDATE
...I I="AG" S MDATE=IDATE
I ADATE=""&(PDATE="")&(MDATE="") D
.S NEW="" S NEW=$O(^BEHOCIR("D",IMAGE,NEW))
S RET=ADATE_U_PDATE_U_MDATE_U_NEW
Q
GETTXT(RET,SNOMED) ;Return text of SNOMED CT
N IN,X,TXT,CODE,DESC
S RET=""
S IN=SNOMED_"^^^1"
S X=$$CONC^BSTSAPI(IN)
S TXT=$P(X,U,4)
S DESC=$P(X,U,3)
S RET=TXT_U_DESC
Q
GETNUM(RET,DFN) ;Return number of CCDAs for a pt
N INVDT,IEN,IMAGE,AREC,PREC,MREC,DCNT,NCNT,ARRAY,DATA,ITYPE
S DCNT=0,NCNT=0
S INVDT=""
F S INVDT=$O(^BEHOCIR("AA",DFN,INVDT)) Q:INVDT="" D
.S IEN="" F S IEN=$O(^BEHOCIR("AA",DFN,INVDT,IEN)) Q:IEN="" D
..S IMAGE=$P($G(^BEHOCIR(IEN,1)),U,1)
..Q:IMAGE=""
..Q:$P($G(^MAG(2005,IMAGE,100)),U,5)'=""
..S ARRAY(IMAGE)=""
S IMG="" F S IMG=$O(ARRAY(IMG)) Q:IMG="" D
.S DATA=""
.S DCNT=DCNT+1
.D GETCIR(.DATA,IMG)
.I $P(DATA,U,1)'=""&($P(DATA,U,2)'="")&($P(DATA,U,3)'="") S NCNT=NCNT+1
S RET=DCNT_U_NCNT
Q
TMPGBL() ;EP
K ^TMP("BEHCIR",$J) Q $NA(^($J))
BEHOCIR ;MSC/IND/MGH - CCD calls ;03-Dec-2013 13:37;du
+1 ;;1.1;BEH COMPONENTS;**066001**;March 12, 2008;Build 1
+2 ;=================================================================
+3 ;Set entry into the CCD
+4 ;The date/time and user will be associated with all the items in the list
+5 ;Input DATA=IEN of reconciliation entry [1]^ DFN [2] ^ BY [3] ^ IMAGE [4] ^ Source [5]^ Allergy date/time [6] ^ Problem dt/time [7] ^ Medication dt/time [8]
+6 ; List(n)=Type [1] ^ Item [2]
SET(RET,DATA,LIST) ;EP
+1 NEW BY,NEW,IEN,IENS,FDA,FNUM,BY,SRC,AREC,PREC,MREC,CNT,WHEN
+2 SET RET=""
SET NEW=""
+3 SET IEN=""
+4 DO TOP(.RET,DATA)
+5 IF +RET=-1
QUIT
+6 SET CNT=""
FOR
SET CNT=$ORDER(LIST(CNT))
IF CNT=""
QUIT
Begin DoDot:1
+7 DO ITEM(IEN,BY)
End DoDot:1
+8 ;Update the dates of the pieces
+9 SET FNUM=90461.63
+10 SET IENS=IEN_","
+11 SET FDA=$NAME(FDA(FNUM,IENS))
+12 SET @FDA@(.07)=AREC
+13 SET @FDA@(.08)=PREC
+14 SET @FDA@(.09)=MREC
+15 DO FILE^DIE("E","FDA","ERR")
+16 IF $DATA(ERR("DIERR"))
SET RET=ERR("DIERR")
+17 IF (AREC'="")&(PREC'="")&(MREC'="")
DO FINISH(IEN)
+18 SET RET=IEN
+19 QUIT
TOP(RET,DATA) ;Get the top entry data and store it
+1 NEW FNUM,FDA,IENS,ERR,IEN2,DFN,IMG
+2 SET IEN=$PIECE(DATA,U,1)
+3 IF IEN=""
SET NEW=1
+4 SET DFN=$PIECE(DATA,U,2)
+5 IF DFN=""
SET RET="-1^No patient identified"
QUIT
+6 SET BY=$PIECE(DATA,U,3)
+7 IF BY=""
SET BY=$$GET1^DIQ(200,DUZ,.01)
+8 SET IMG=$PIECE(DATA,U,4)
+9 ;I IMG="" S RET="-1^No CCDA identified" Q
+10 SET SRC=$PIECE(DATA,U,5)
+11 SET AREC=$PIECE(DATA,U,6)
+12 SET PREC=$PIECE(DATA,U,7)
+13 SET MREC=$PIECE(DATA,U,8)
+14 SET FNUM=90461.63
+15 SET IENS=$SELECT('NEW:IEN_",",1:"+1,")
+16 SET FDA=$NAME(FDA(FNUM,IENS))
+17 IF NEW
SET @FDA@(.01)=$$NOW^XLFDT
+18 IF NEW
SET @FDA@(.02)=DFN
+19 SET @FDA@(.03)=SRC
+20 SET @FDA@(.05)=BY
+21 SET @FDA@(1.1)=IMG
+22 IF NEW
Begin DoDot:1
+23 DO UPDATE^DIE("","FDA","IEN2","ERR")
+24 IF $DATA(ERR)
SET RET="-1^Unable to add reconcillation data"
+25 IF '$TEST
SET IEN=IEN2(1)
End DoDot:1
+26 IF '$TEST
Begin DoDot:1
+27 DO FILE^DIE("E","FDA","ERR")
+28 IF $DATA(ERR("DIERR"))
SET RET=ERR("DIERR")
End DoDot:1
+29 QUIT
ITEM(IEN,BY) ;Store each item
+1 NEW FDA,DIERR,TYPE,AIEN,IENS,ERR,TIEN
+2 IF IEN=""
QUIT
+3 SET TYPE=$PIECE(LIST(CNT),U,1)
+4 SET TIEN=$PIECE(LIST(CNT),U,2)
+5 SET AIEN="+1,"_IEN_","
+6 SET FDA=$NAME(FDA(90461.632,AIEN))
+7 SET @FDA@(.01)=$SELECT(TYPE="A":AREC,TYPE="CA":AREC,TYPE="P":PREC,TYPE="CP":PREC,1:MREC)
+8 SET @FDA@(.02)=DUZ
+9 SET @FDA@(.03)=TYPE
+10 IF TYPE["C"
SET @FDA@(.05)=TIEN
+11 IF '$TEST
SET @FDA@(.04)=+TIEN
+12 IF AREC'=""
SET @FDA@(.07)=AREC
+13 IF PREC'=""
SET @FDA@(.08)=PREC
+14 IF MREC'=""
SET @FDA@(.09)=MREC
+15 DO UPDATE^DIE("","FDA","IENS","ERR")
+16 IF $GET(DIERR)
SET RET=-ERR("DIERR",1)_U_ERR("DIERR",1,"TEXT",1)
+17 QUIT
FINISH(IEN) ;Mark it reconciled
+1 NEW FDA,ERR
+2 SET FDA=$NAME(FDA(90461.63,IEN))
+3 SET @FDA@(.04)=1
+4 DO UPDATE^DIE("","FDA","","ERR")
+5 QUIT
+6 ;Get latest reconcilations for a CCDA
+7 ;Input=Image IEN
+8 ;Ouput=Alg date[1] ^ Prob date [2] ^ med date[3] ^ NEW ien [4]
GETCIR(RET,IMAGE) ;Get the reconciliations for a CCDS
+1 NEW INVA,IEN,FIELD,IDATE,ADATE,PDATE,MDATE,NEW,I
+2 SET (ADATE,PDATE,MDATE,NEW)=""
+3 SET RET=""
+4 FOR I="AE","AF","AG"
Begin DoDot:1
+5 SET INVA=""
SET INVA=$ORDER(^BEHOCIR(I,IMAGE,INVA))
IF INVA=""
QUIT
Begin DoDot:2
+6 SET IEN=""
SET IEN=$ORDER(^BEHOCIR(I,IMAGE,INVA,IEN))
IF IEN=""
QUIT
Begin DoDot:3
+7 SET FIELD=$SELECT(I="AE":.07,I="AF":.08,I="AG":.09)
+8 SET IDATE=$$GET1^DIQ(90461.63,IEN,FIELD)
+9 IF I="AE"
SET ADATE=IDATE
+10 IF I="AF"
SET PDATE=IDATE
+11 IF I="AG"
SET MDATE=IDATE
End DoDot:3
End DoDot:2
End DoDot:1
+12 IF ADATE=""&(PDATE="")&(MDATE="")
Begin DoDot:1
+13 SET NEW=""
SET NEW=$ORDER(^BEHOCIR("D",IMAGE,NEW))
End DoDot:1
+14 SET RET=ADATE_U_PDATE_U_MDATE_U_NEW
+15 QUIT
GETTXT(RET,SNOMED) ;Return text of SNOMED CT
+1 NEW IN,X,TXT,CODE,DESC
+2 SET RET=""
+3 SET IN=SNOMED_"^^^1"
+4 SET X=$$CONC^BSTSAPI(IN)
+5 SET TXT=$PIECE(X,U,4)
+6 SET DESC=$PIECE(X,U,3)
+7 SET RET=TXT_U_DESC
+8 QUIT
GETNUM(RET,DFN) ;Return number of CCDAs for a pt
+1 NEW INVDT,IEN,IMAGE,AREC,PREC,MREC,DCNT,NCNT,ARRAY,DATA,ITYPE
+2 SET DCNT=0
SET NCNT=0
+3 SET INVDT=""
+4 FOR
SET INVDT=$ORDER(^BEHOCIR("AA",DFN,INVDT))
IF INVDT=""
QUIT
Begin DoDot:1
+5 SET IEN=""
FOR
SET IEN=$ORDER(^BEHOCIR("AA",DFN,INVDT,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+6 SET IMAGE=$PIECE($GET(^BEHOCIR(IEN,1)),U,1)
+7 IF IMAGE=""
QUIT
+8 IF $PIECE($GET(^MAG(2005,IMAGE,100)),U,5)'=""
QUIT
+9 SET ARRAY(IMAGE)=""
End DoDot:2
End DoDot:1
+10 SET IMG=""
FOR
SET IMG=$ORDER(ARRAY(IMG))
IF IMG=""
QUIT
Begin DoDot:1
+11 SET DATA=""
+12 SET DCNT=DCNT+1
+13 DO GETCIR(.DATA,IMG)
+14 IF $PIECE(DATA,U,1)'=""&($PIECE(DATA,U,2)'="")&($PIECE(DATA,U,3)'="")
SET NCNT=NCNT+1
End DoDot:1
+15 SET RET=DCNT_U_NCNT
+16 QUIT
TMPGBL() ;EP
+1 KILL ^TMP("BEHCIR",$JOB)
QUIT $NAME(^($JOB))
