source: WorldVistAEHR/trunk/r/PATIENT_REPRESENTATIVE-QAC/QACPRT.m@ 949

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

initial load of WorldVistAEHR

File size: 2.1 KB
RevLine 
[613]1QACPRT ;HISC/RS,CEW - This routine is a print of all contact data ;7/19/95 15:22
2 ;;2.0;Patient Representative;;07/25/1995
3 K DIR S DIR(0)="SO^C:Contact Number;D:Date Range;"
4 S DIR("A")="Select records by"
5 S DIR("?",1)="Enter 'C' to select records by contact number."
6 S DIR("?",2)="Enter 'D' to select all records over a date range."
7 S DIR("?")="Choose the method of record selection."
8 W ! D ^DIR G:$D(DIRUT) EXIT S QACSELCT=Y
9 I QACSELCT="C" D G:QAQQUIT EXIT
10 . S QAQDIC="^QA(745.1,",QAQDIC(0)="AEMNQZ"
11 . S QAQDIC("A")="Select CONTACT NUMBER: "
12 . S QAQUTIL="QACPRT" D ^QAQSELCT
13 . Q
14 I QACSELCT="D" D G:QAQQUIT EXIT
15 . D ^QAQDATE Q:QAQQUIT
16 . S Y=$O(^QA(745.1,"D",(QAQNBEG-.0000001)))
17 . I (Y'>0)!(Y\1>QAQNEND) D
18 .. W !,"No records found within this date range.",$C(7)
19 .. S QAQQUIT=1
20 .. Q
21 . Q
22 K %ZIS,IOP S %ZIS="MNQ" W ! D ^%ZIS G:POP EXIT
23 I $D(IO("Q")) K IO("Q") D G EXIT
24 . S ZTRTN="ENTSK^QACPRT",ZTDESC="Contact Inquiry"
25 . S (ZTSAVE("QAQNBEG"),ZTSAVE("QAQNEND"),ZTSAVE("QACSELCT"))=""
26 . S ZTSAVE("^UTILITY($J,")="" D ^%ZTLOAD
27 . Q
28ENTSK ;TASKED ENTRY POINT
29 I $G(QACSELCT)="D" D
30 . S QACDT=QAQNBEG-.0000001
31 . F S QACDT=$O(^QA(745.1,"D",QACDT)) Q:QACDT'>0!(QACDT\1>QAQNEND) D
32 .. S QACD0=0
33 .. F S QACD0=$O(^QA(745.1,"D",QACDT,QACD0)) Q:QACD0'>0 D
34 ... S X=$P($G(^QA(745.1,QACD0,0)),U)
35 ... I X]"" S ^UTILITY($J,"QACPRT",X,QACD0)=""
36 ... Q
37 .. Q
38 . Q
39 S QACQUIT=0,QACNUM="",QACIOST=IOST
40 S QACIOP=ION_";"_IOST_";"_IOM_";"_IOSL
41 S %X="^UTILITY($J,""QACPRT"",",%Y="^TMP($J,""QACPRT""," D %XY^%RCR
42 F S QACNUM=$O(^TMP($J,"QACPRT",QACNUM)) Q:QACNUM=""!QACQUIT F QACD0=0:0 S QACD0=$O(^TMP($J,"QACPRT",QACNUM,QACD0)) Q:QACD0'>0!QACQUIT D
43 . S DIC="^QA(745.1,",BY="@NUMBER",(FR,TO)=QACD0,FLDS="[CAPTIONED]",L=0
44 . S IOP=QACIOP S DIOBEG="S DIQ(0)=""C""" D EN1^DIP
45 . S QACHK=$O(^TMP($J,"QACPRT",QACNUM))
46 . I $E(QACIOST)="C",(QACHK]"") D
47 .. K DIR S DIR(0)="E" D ^DIR
48 .. S QACQUIT=$S(Y'>0:1,1:0)
49 .. Q
50 . Q
51EXIT ;
52 D ^%ZISC,HOME^%ZIS S:$D(ZTQUEUED) ZTREQ="@"
53 K %ZIS,BY,DIC,DIR,FLDS,FR,P,POP,QACHK,QACD0,QACIOP,QACQUIT,QAQDIC
54 K QAQQUIT,QACIOST,QACNUM,QAQUTIL,TO,Y,ZTDESC,ZTRTN,ZTSAVE,DA,L
55 K ^TMP($J,"QACPRT"),^UTILITY($J,"QACPRT"),%X,%Y,DIOBEG,QACSELCT,QACDT
56 D K^QAQDATE
57 Q
Note: See TracBrowser for help on using the repository browser.