| 1 | QACPRT ;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
|
|---|
| 28 | ENTSK ;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
|
|---|
| 51 | EXIT ;
|
|---|
| 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
|
|---|
