source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGENRPT5.m@ 1520

Last change on this file since 1520 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.8 KB
RevLine 
[613]1DGENRPT5 ;ALB/DW,LBD,GAH,PHH - EGT Impact Report Utility; 06/21/2007
2 ;;5.3;Registration;**568,725,758**;Aug 13,1993;Build 1
3 ;
4 ;
5 Q
6GETAPPT(TYPE) ; Set up array of Patient IENs for SD API to process
7 N VETARRAY,PIEN,PNAME,RCNT,ACNT,DGARRAY,SDCNT,I
8 S ACNT=1,RCNT=0
9 S PNAME="" F S PNAME=$O(^TMP($J,TYPE,PNAME)) Q:PNAME="" D
10 .S PIEN=0 F S PIEN=$O(^TMP($J,TYPE,PNAME,PIEN)) Q:'PIEN D
11 ..S RCNT=RCNT+1,VETARRAY(ACNT)=$G(VETARRAY(ACNT))_PIEN_";"
12 ..; Group DFNs by no more than twenty records
13 ..I RCNT>19 S ACNT=ACNT+1,RCNT=0
14 ;
15 ; Call SD API by array of Patient DFNs
16 F I=1:1 Q:'$D(VETARRAY(I)) D
17 .S DGARRAY("FLDS")="1;2;3;10",DGARRAY(4)=VETARRAY(I)
18 .S SDCNT=$$SDAPI^SDAMA301(.DGARRAY)
19 .I SDCNT<0 D
20 ..N ERR,ERROR,CNT
21 ..S ERR=$O(^TMP($J,"SDAMA301",""))
22 ..D
23 ...I ERR=101 S ERROR="Appt. DB unavail. Try later" Q
24 ...I ERR=115 S ERROR="Invalid reqst, Call help desk" Q
25 ...I ERR=117 S ERROR="Error: Check RSA error log" Q
26 ...I ERR=113 S ERROR="Bad appt,pat stat fltr combo" Q
27 ...I ERR=109 S ERROR="Invalid appt status filter" Q
28 ...S ERROR=^TMP($J,"SDAMA301",ERR)
29 ..F CNT=1:1:$L(VETARRAY(I),";")-1 S ^TMP($J,"SDAMA",$P(VETARRAY(I),";",CNT),"ERROR")=ERROR
30 .;
31 .I SDCNT>0 M ^TMP($J,"SDAMA")=^TMP($J,"SDAMA301")
32 .K ^TMP($J,"SDAMA301")
33 .K DGARRAY
34 Q
35 ;
36BLDUTL(DFN) ; Build Utility Global Entries for records processed
37 Q:'$D(^TMP($J,"SDAMA",DFN))
38 N CLIEN,APPTDT,NODE,APPTNUM S APPTNUM=1
39 S CLIEN=0 F S CLIEN=$O(^TMP($J,"SDAMA",DFN,CLIEN)) Q:'CLIEN D
40 .S APPTDT=0 F S APPTDT=$O(^TMP($J,"SDAMA",DFN,CLIEN,APPTDT)) Q:'APPTDT D
41 ..Q:APPTDT'>DT
42 ..S NODE=^TMP($J,"SDAMA",DFN,CLIEN,APPTDT)
43 ..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)
44 ..S ^UTILITY("VASD",$J,APPTNUM,"I")=NODE,APPTNUM=APPTNUM+1
45 K ^TMP($J,"SDAMA",DFN)
46 Q
Note: See TracBrowser for help on using the repository browser.