DGENRPT5 ;ALB/DW,LBD,GAH,PHH - EGT Impact Report Utility; 06/21/2007
;;5.3;Registration;**568,725,758**;Aug 13,1993;Build 1
;
;
Q
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
Q
;
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)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGENRPT5 1857 printed Nov 22, 2024@17:53:10 Page 2
DGENRPT5 ;ALB/DW,LBD,GAH,PHH - EGT Impact Report Utility; 06/21/2007
+1 ;;5.3;Registration;**568,725,758**;Aug 13,1993;Build 1
+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
