Routine: DGENRPT5

DGENRPT5 ;ALB/DW,LBD,GAH,PHH - EGT Impact Report Utility; 06/21/2007

 ;;5.3;Registration;**568,725,758,1015**;Aug 13,1993;Build 21

GETAPPT(TYPE) ; Set up array of Patient IENs for SD API to process

 N VETARRAY,PIEN,PNAME,RCNT,ACNT,DGARRAY,SDCNT,I

 S ACNT=1,RCNT=0

 S PNAME="" F  S PNAME=$O(^TMP($J,TYPE,PNAME)) Q:PNAME=""  D

 .S PIEN=0 F  S PIEN=$O(^TMP($J,TYPE,PNAME,PIEN)) Q:'PIEN  D

 ..S RCNT=RCNT+1,VETARRAY(ACNT)=$G(VETARRAY(ACNT))_PIEN_";"

 ..; Group DFNs by no more than twenty records

 ..I RCNT>19 S ACNT=ACNT+1,RCNT=0

 ; Call SD API by array of Patient DFNs

 F I=1:1 Q:'$D(VETARRAY(I))  D

 .S DGARRAY("FLDS")="1;2;3;10",DGARRAY(4)=VETARRAY(I)

 .S SDCNT=$$SDAPI^SDAMA301(.DGARRAY)

 .I SDCNT<0 D

 ..N ERR,ERROR,CNT

 ..S ERR=$O(^TMP($J,"SDAMA301",""))

..D

 ...I ERR=101 S ERROR="Appt. DB unavail. Try later" Q

 ...I ERR=115 S ERROR="Invalid reqst, Call help desk" Q

 ...I ERR=117 S ERROR="Error:  Check RSA error log" Q

 ...I ERR=113 S ERROR="Bad appt,pat stat fltr combo" Q

 ...I ERR=109 S ERROR="Invalid appt status filter" Q

 ...S ERROR=^TMP($J,"SDAMA301",ERR)

 ..F CNT=1:1:$L(VETARRAY(I),";")-1 S ^TMP($J,"SDAMA",$P(VETARRAY(I),";",CNT),"ERROR")=ERROR

.;

 .I SDCNT>0 M ^TMP($J,"SDAMA")=^TMP($J,"SDAMA301")

 .K ^TMP($J,"SDAMA301")

 .K DGARRAY

BLDUTL(DFN) ; Build Utility Global Entries for records processed

 Q:'$D(^TMP($J,"SDAMA",DFN))

 N CLIEN,APPTDT,NODE,APPTNUM S APPTNUM=1

 S CLIEN=0  F  S CLIEN=$O(^TMP($J,"SDAMA",DFN,CLIEN)) Q:'CLIEN  D

 .S APPTDT=0 F  S APPTDT=$O(^TMP($J,"SDAMA",DFN,CLIEN,APPTDT)) Q:'APPTDT  D

 ..Q:APPTDT'>DT

 ..S NODE=^TMP($J,"SDAMA",DFN,CLIEN,APPTDT)

 ..S ^UTILITY("VASD",$J,APPTNUM,"E")=$$FMTE^DILIBF($P(NODE,U),"5U")_U_$P($P(NODE,U,2),";",2)_U_U_$P($P(NODE,U,10),";",2)

 ..S ^UTILITY("VASD",$J,APPTNUM,"I")=NODE,APPTNUM=APPTNUM+1

 K ^TMP($J,"SDAMA",DFN)

DGENRPT5  ;ALB/DW,LBD,GAH,PHH - EGT Impact Report Utility; 06/21/2007

 +1       ;;5.3;Registration;**568,725,758,1015**;Aug 13,1993;Build 21

 +2       ;

 +3       ;

 +4        QUIT

GETAPPT(TYPE) ; Set up array of Patient IENs for SD API to process

 +1        NEW VETARRAY,PIEN,PNAME,RCNT,ACNT,DGARRAY,SDCNT,I

 +2        SET ACNT=1

           SET RCNT=0

 +3        SET PNAME=""

FOR

               SET PNAME=$ORDER(^TMP($JOB,TYPE,PNAME))

               IF PNAME=""

                   QUIT

               Begin DoDot:1

 +4                SET PIEN=0

FOR

                       SET PIEN=$ORDER(^TMP($JOB,TYPE,PNAME,PIEN))

                       IF 'PIEN

                           QUIT

                       Begin DoDot:2

 +5                        SET RCNT=RCNT+1

                           SET VETARRAY(ACNT)=$GET(VETARRAY(ACNT))_PIEN_";"

 +6       ; Group DFNs by no more than twenty records

 +7                        IF RCNT>19

                               SET ACNT=ACNT+1

                               SET RCNT=0

                       End DoDot:2

               End DoDot:1

 +8       ;

 +9       ; Call SD API by array of Patient DFNs

 +10       FOR I=1:1

               IF '$DATA(VETARRAY(I))

                   QUIT

               Begin DoDot:1

 +11               SET DGARRAY("FLDS")="1;2;3;10"

                   SET DGARRAY(4)=VETARRAY(I)

 +12               SET SDCNT=$$SDAPI^SDAMA301(.DGARRAY)

 +13               IF SDCNT<0

                       Begin DoDot:2

 +14                       NEW ERR,ERROR,CNT

 +15                       SET ERR=$ORDER(^TMP($JOB,"SDAMA301",""))

 +16                       Begin DoDot:3

 +17                           IF ERR=101

                                   SET ERROR="Appt. DB unavail. Try later"

                                   QUIT

 +18                           IF ERR=115

                                   SET ERROR="Invalid reqst, Call help desk"

                                   QUIT

 +19                           IF ERR=117

                                   SET ERROR="Error:  Check RSA error log"

                                   QUIT

 +20                           IF ERR=113

                                   SET ERROR="Bad appt,pat stat fltr combo"

                                   QUIT

 +21                           IF ERR=109

                                   SET ERROR="Invalid appt status filter"

                                   QUIT

 +22                           SET ERROR=^TMP($JOB,"SDAMA301",ERR)

                           End DoDot:3

 +23                       FOR CNT=1:1:$LENGTH(VETARRAY(I),";")-1

                               SET ^TMP($JOB,"SDAMA",$PIECE(VETARRAY(I),";",CNT),"ERROR")=ERROR

                       End DoDot:2

 +24      ;

 +25               IF SDCNT>0

                       MERGE ^TMP($JOB,"SDAMA")=^TMP($JOB,"SDAMA301")

 +26               KILL ^TMP($JOB,"SDAMA301")

 +27               KILL DGARRAY

               End DoDot:1

 +28       QUIT

 +29      ;

BLDUTL(DFN) ; Build Utility Global Entries for records processed

 +1        IF '$DATA(^TMP($JOB,"SDAMA",DFN))

               QUIT

 +2        NEW CLIEN,APPTDT,NODE,APPTNUM

           SET APPTNUM=1

 +3        SET CLIEN=0

FOR

               SET CLIEN=$ORDER(^TMP($JOB,"SDAMA",DFN,CLIEN))

               IF 'CLIEN

                   QUIT

               Begin DoDot:1

 +4                SET APPTDT=0

FOR

                       SET APPTDT=$ORDER(^TMP($JOB,"SDAMA",DFN,CLIEN,APPTDT))

                       IF 'APPTDT

                           QUIT

                       Begin DoDot:2

 +5                        IF APPTDT'>DT

                               QUIT

 +6                        SET NODE=^TMP($JOB,"SDAMA",DFN,CLIEN,APPTDT)

 +7                        SET ^UTILITY("VASD",$JOB,APPTNUM,"E")=$$FMTE^DILIBF($PIECE(NODE,U),"5U")_U_$PIECE($PIECE(NODE,U,2),";",2)_U_U_$PIECE($PIECE(NODE,U,10),";",2)

 +8                        SET ^UTILITY("VASD",$JOB,APPTNUM,"I")=NODE

                           SET APPTNUM=APPTNUM+1

                       End DoDot:2

               End DoDot:1

 +9        KILL ^TMP($JOB,"SDAMA",DFN)

 +10       QUIT

DGENRPT5.m