BEHOCIR1 ;MSC/IND/MGH - CCD calls ;06-Nov-2014 16:53;PLS
;;1.1;BEH COMPONENTS;**066001,066002**;March 12, 2008;Build 2
;=================================================================
; RPC: BEHOCIR1 GETCCDS
; Call to return a list of CCDs for a patient.
; Input is the pt and the date range
GETCCDS(DATA,DFN,STRTDT,ENDDT) ;
N FLGS,MISCPRMS,LIST,TXT,I
S FLGS="CE",DATA=$$TMPGBL
S MISCPRMS(1)="IDFN^^"_DFN
S MISCPRMS(2)="IXCLASS^^CLIN"
S MISCPRMS(3)="IXTYPE^^CCD-SUMMARY"
D GETIMGS^MAGSIXG1(.LIST,FLGS,STRTDT,ENDDT,"",.MISCPRMS)
S I="" F S I=$O(LIST(I)) Q:I="" D
.I I=0!(I=1) D
..S @DATA@(I)=LIST(I)
.E D
..S TXT=$G(LIST(I))
..I $P(TXT,U,10)="CCD-SUMMARY" S @DATA@(I)=LIST(I)
Q
;RPC Find Reconciliation entries for a patient
;Input=patient DFN
; Start date
; end date
;Return list of CCD entries
;IEN^PATIENT^DATE STORED^SOURCE^RECONCILED^IMAGE^OID^EXT
PTCCD(RET,DFN,STRTDT,ENDDT) ;list of entries
N BEGDT,EDATE,FIRST,IEN,CNT,IDTE,SRC,RES,REC,IMAGE,OID,EXT,ADATE,PDATE,MDATE,NEW,STRING,IARRAY
S RET=$$TMPGBL()
S CNT=0,IARRAY=""
I $G(STRTDT)="" S STRTDT=3000101
I $G(ENDDT)="" S ENDDT=$$NOW^XLFDT
S BEGDT=9999999-STRTDT,EDATE=9999999-ENDDT
S BEGDT=BEGDT+1
S FIRST=EDATE-0.1 F S FIRST=$O(^BEHOCIR("AA",DFN,FIRST)) Q:FIRST=""!($P(FIRST,".",1)>BEGDT) D
.S IEN="" F S IEN=$O(^BEHOCIR("AA",DFN,FIRST,IEN)) Q:IEN="" D
..S IMAGE=$$GET1^DIQ(90461.63,IEN,1.1,"I")
..S SRC=$$GET1^DIQ(90461.63,IEN,.03)
..S IDTE=$$GET1^DIQ(90461.63,IEN,.01)
..S REC=$$GET1^DIQ(90461.63,IEN,.04)
..S RES=$$GET1^DIQ(90461.63,IEN,.05)
..D DTE
S I="" F S I=$O(IARRAY(I)) Q:I="" D
.S CNT=CNT+1
.S @RET@(CNT)=$G(IARRAY(I))
Q
DTE ;Check reconcillation dates
S ADATE=$$GET1^DIQ(90461.63,IEN,.07)
S PDATE=$$GET1^DIQ(90461.63,IEN,.08)
S MDATE=$$GET1^DIQ(90461.63,IEN,.09)
I '+IMAGE D Q
.S STRING=IEN_U_IDTE_U_SRC_U_REC_U_IMAGE_U_ADATE_U_PDATE_U_MDATE_U_RES
.S CNT=CNT+1
.S @RET@(CNT)=STRING
I $D(IARRAY(IMAGE)) D
.S DATA=$G(IARRAY(IMAGE))
.I ADATE>$P(DATA,U,6) S $P(DATA,U,6)=ADATE
.I PDATE>$P(DATA,U,7) S $P(DATA,U,7)=PDATE
.I MDATE>$P(DATA,U,8) S $P(DATA,U,8)=MDATE
E D
.S IARRAY(IMAGE)=IEN_U_IDTE_U_SRC_U_REC_U_IMAGE_U_ADATE_U_PDATE_U_MDATE_U_RES
Q
CCDCHECK ;EP
N ST,TMP,X,Y
S ST=$$GET^XPAR("SYS","BEHOCIR IMAGE SEARCH DT",1,"I")
D ADDTOLST(ST)
Q
ADDTOLST(ST) ;EP
;Loop through Image file from last date stored and add any CCD type images to the BEH RECONCILIATION list
N LSTDT,IEN,TYPE,DESC,PT,NOW,ERR,SAVE,MAGRY
S NOW=$$NOW^XLFDT
S LSTDT=ST F S LSTDT=$O(^MAG(2005,"AD",LSTDT)) Q:LSTDT="" D
.S IEN="" F S IEN=$O(^MAG(2005,"AD",LSTDT,IEN)) Q:IEN="" D
..S TYPE=$$GET1^DIQ(2005,IEN,42)
..S DESC=$$GET1^DIQ(2005,IEN,100)
..I TYPE="CCD-SUMMARY" D
...Q:DESC="LOCAL SITE ENTRY"
...S PT=$$GET1^DIQ(2005,IEN,5)
...S SAVE=$$GET1^DIQ(2005,IEN,7)
...D LOAD(.MAGRY,IEN)
D PUT^XPAR("SYS","BEHOCIR IMAGE SEARCH DT",1,NOW,.ERR)
Q
LOAD(MAGRY,MAGIEN) ;Save the data
N FDA,ERR,CHK,CAP,DFN,DATA
S CAP=$$GET1^DIQ(2005,MAGIEN,8.1,"I")
Q:CAP="I"
S MAGRY(0)="1^Storage to reconciliation file"
;S MAGRY(1)=MAGIEN_" "_$$NOW^XLFDT
;Quit if this image is already saved
S CHK="" S CHK=$O(^BEHOCIR("D",MAGIEN,CHK))
Q:+CHK
S FDA=$NA(FDA(90461.63,"+1,"))
S @FDA@(.01)=$$NOW^XLFDT
S DFN=$$GET1^DIQ(2005,MAGIEN,5,"I")
S @FDA@(.02)="`"_DFN
S @FDA@(1.1)="`"_MAGIEN
D UPDATE^DIE("E","FDA",,"ERR")
; Fire update event
D GETNUM^BEHOCIR(.DATA,DFN)
D BRDCAST^CIANBEVT("CIR."_DFN,DATA)
Q
TMPGBL() ;EP
K ^TMP("BEHCIR",$J) Q $NA(^($J))
AUTO ;EP
;Trigger setting up this routine in the taskman scheduling file
K %DT,DIC
N START,X,Y,DIE
S DIC(0)="XZM",(DIE,DIC)="^DIC(19.2,",X="BEHOCIR CCDADD"
D ^DIC
Q:+Y>0
S START=$$FMADD^XLFDT($$NOW^XLFDT(),,,60)
D RESCH^XUTMOPT("BEHOCIR",START,"","1H","L")
Q
BEHOCIR1 ;MSC/IND/MGH - CCD calls ;06-Nov-2014 16:53;PLS
+1 ;;1.1;BEH COMPONENTS;**066001,066002**;March 12, 2008;Build 2
+2 ;=================================================================
+3 ; RPC: BEHOCIR1 GETCCDS
+4 ; Call to return a list of CCDs for a patient.
+5 ; Input is the pt and the date range
GETCCDS(DATA,DFN,STRTDT,ENDDT) ;
+1 NEW FLGS,MISCPRMS,LIST,TXT,I
+2 SET FLGS="CE"
SET DATA=$$TMPGBL
+3 SET MISCPRMS(1)="IDFN^^"_DFN
+4 SET MISCPRMS(2)="IXCLASS^^CLIN"
+5 SET MISCPRMS(3)="IXTYPE^^CCD-SUMMARY"
+6 DO GETIMGS^MAGSIXG1(.LIST,FLGS,STRTDT,ENDDT,"",.MISCPRMS)
+7 SET I=""
FOR
SET I=$ORDER(LIST(I))
IF I=""
QUIT
Begin DoDot:1
+8 IF I=0!(I=1)
Begin DoDot:2
+9 SET @DATA@(I)=LIST(I)
End DoDot:2
+10 IF '$TEST
Begin DoDot:2
+11 SET TXT=$GET(LIST(I))
+12 IF $PIECE(TXT,U,10)="CCD-SUMMARY"
SET @DATA@(I)=LIST(I)
End DoDot:2
End DoDot:1
+13 QUIT
+14 ;RPC Find Reconciliation entries for a patient
+15 ;Input=patient DFN
+16 ; Start date
+17 ; end date
+18 ;Return list of CCD entries
+19 ;IEN^PATIENT^DATE STORED^SOURCE^RECONCILED^IMAGE^OID^EXT
PTCCD(RET,DFN,STRTDT,ENDDT) ;list of entries
+1 NEW BEGDT,EDATE,FIRST,IEN,CNT,IDTE,SRC,RES,REC,IMAGE,OID,EXT,ADATE,PDATE,MDATE,NEW,STRING,IARRAY
+2 SET RET=$$TMPGBL()
+3 SET CNT=0
SET IARRAY=""
+4 IF $GET(STRTDT)=""
SET STRTDT=3000101
+5 IF $GET(ENDDT)=""
SET ENDDT=$$NOW^XLFDT
+6 SET BEGDT=9999999-STRTDT
SET EDATE=9999999-ENDDT
+7 SET BEGDT=BEGDT+1
+8 SET FIRST=EDATE-0.1
FOR
SET FIRST=$ORDER(^BEHOCIR("AA",DFN,FIRST))
IF FIRST=""!($PIECE(FIRST,".",1)>BEGDT)
QUIT
Begin DoDot:1
+9 SET IEN=""
FOR
SET IEN=$ORDER(^BEHOCIR("AA",DFN,FIRST,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+10 SET IMAGE=$$GET1^DIQ(90461.63,IEN,1.1,"I")
+11 SET SRC=$$GET1^DIQ(90461.63,IEN,.03)
+12 SET IDTE=$$GET1^DIQ(90461.63,IEN,.01)
+13 SET REC=$$GET1^DIQ(90461.63,IEN,.04)
+14 SET RES=$$GET1^DIQ(90461.63,IEN,.05)
+15 DO DTE
End DoDot:2
End DoDot:1
+16 SET I=""
FOR
SET I=$ORDER(IARRAY(I))
IF I=""
QUIT
Begin DoDot:1
+17 SET CNT=CNT+1
+18 SET @RET@(CNT)=$GET(IARRAY(I))
End DoDot:1
+19 QUIT
DTE ;Check reconcillation dates
+1 SET ADATE=$$GET1^DIQ(90461.63,IEN,.07)
+2 SET PDATE=$$GET1^DIQ(90461.63,IEN,.08)
+3 SET MDATE=$$GET1^DIQ(90461.63,IEN,.09)
+4 IF '+IMAGE
Begin DoDot:1
+5 SET STRING=IEN_U_IDTE_U_SRC_U_REC_U_IMAGE_U_ADATE_U_PDATE_U_MDATE_U_RES
+6 SET CNT=CNT+1
+7 SET @RET@(CNT)=STRING
End DoDot:1
QUIT
+8 IF $DATA(IARRAY(IMAGE))
Begin DoDot:1
+9 SET DATA=$GET(IARRAY(IMAGE))
+10 IF ADATE>$PIECE(DATA,U,6)
SET $PIECE(DATA,U,6)=ADATE
+11 IF PDATE>$PIECE(DATA,U,7)
SET $PIECE(DATA,U,7)=PDATE
+12 IF MDATE>$PIECE(DATA,U,8)
SET $PIECE(DATA,U,8)=MDATE
End DoDot:1
+13 IF '$TEST
Begin DoDot:1
+14 SET IARRAY(IMAGE)=IEN_U_IDTE_U_SRC_U_REC_U_IMAGE_U_ADATE_U_PDATE_U_MDATE_U_RES
End DoDot:1
+15 QUIT
CCDCHECK ;EP
+1 NEW ST,TMP,X,Y
+2 SET ST=$$GET^XPAR("SYS","BEHOCIR IMAGE SEARCH DT",1,"I")
+3 DO ADDTOLST(ST)
+4 QUIT
ADDTOLST(ST) ;EP
+1 ;Loop through Image file from last date stored and add any CCD type images to the BEH RECONCILIATION list
+2 NEW LSTDT,IEN,TYPE,DESC,PT,NOW,ERR,SAVE,MAGRY
+3 SET NOW=$$NOW^XLFDT
+4 SET LSTDT=ST
FOR
SET LSTDT=$ORDER(^MAG(2005,"AD",LSTDT))
IF LSTDT=""
QUIT
Begin DoDot:1
+5 SET IEN=""
FOR
SET IEN=$ORDER(^MAG(2005,"AD",LSTDT,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+6 SET TYPE=$$GET1^DIQ(2005,IEN,42)
+7 SET DESC=$$GET1^DIQ(2005,IEN,100)
+8 IF TYPE="CCD-SUMMARY"
Begin DoDot:3
+9 IF DESC="LOCAL SITE ENTRY"
QUIT
+10 SET PT=$$GET1^DIQ(2005,IEN,5)
+11 SET SAVE=$$GET1^DIQ(2005,IEN,7)
+12 DO LOAD(.MAGRY,IEN)
End DoDot:3
End DoDot:2
End DoDot:1
+13 DO PUT^XPAR("SYS","BEHOCIR IMAGE SEARCH DT",1,NOW,.ERR)
+14 QUIT
LOAD(MAGRY,MAGIEN) ;Save the data
+1 NEW FDA,ERR,CHK,CAP,DFN,DATA
+2 SET CAP=$$GET1^DIQ(2005,MAGIEN,8.1,"I")
+3 IF CAP="I"
QUIT
+4 SET MAGRY(0)="1^Storage to reconciliation file"
+5 ;S MAGRY(1)=MAGIEN_" "_$$NOW^XLFDT
+6 ;Quit if this image is already saved
+7 SET CHK=""
SET CHK=$ORDER(^BEHOCIR("D",MAGIEN,CHK))
+8 IF +CHK
QUIT
+9 SET FDA=$NAME(FDA(90461.63,"+1,"))
+10 SET @FDA@(.01)=$$NOW^XLFDT
+11 SET DFN=$$GET1^DIQ(2005,MAGIEN,5,"I")
+12 SET @FDA@(.02)="`"_DFN
+13 SET @FDA@(1.1)="`"_MAGIEN
+14 DO UPDATE^DIE("E","FDA",,"ERR")
+15 ; Fire update event
+16 DO GETNUM^BEHOCIR(.DATA,DFN)
+17 DO BRDCAST^CIANBEVT("CIR."_DFN,DATA)
+18 QUIT
TMPGBL() ;EP
+1 KILL ^TMP("BEHCIR",$JOB)
QUIT $NAME(^($JOB))
AUTO ;EP
+1 ;Trigger setting up this routine in the taskman scheduling file
+2 KILL %DT,DIC
+3 NEW START,X,Y,DIE
+4 SET DIC(0)="XZM"
SET (DIE,DIC)="^DIC(19.2,"
SET X="BEHOCIR CCDADD"
+5 DO ^DIC
+6 IF +Y>0
QUIT
+7 SET START=$$FMADD^XLFDT($$NOW^XLFDT(),,,60)
+8 DO RESCH^XUTMOPT("BEHOCIR",START,"","1H","L")
+9 QUIT
