Routine: BEHOCIR1

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)

 ;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))

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

CCDCHECK ;EP

 N ST,TMP,X,Y

 S ST=$$GET^XPAR("SYS","BEHOCIR IMAGE SEARCH DT",1,"I")

 D ADDTOLST(ST)

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)

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)

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")

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

BEHOCIR1.m