| 1 | QACSTAT ;HISC/RS - This routine will reopen, close, or delete a contact for the Patient Rep. ;3/21/95 10:03
|
|---|
| 2 | ;;2.0;Patient Representative;**3,5**;07/25/1995
|
|---|
| 3 | S (DIC,DIE)="^QA(745.1,",DIC(0)="AEMQZ",DIC("A")="Select CONTACT NUMBER: "
|
|---|
| 4 | D ^DIC I Y<0!(Y="^") K DIC,DIE Q
|
|---|
| 5 | ;Display Contact data to be reopen or deleted
|
|---|
| 6 | K DA,DR,DIC,DIQ,TMP
|
|---|
| 7 | S DA=+Y,DIC=745.1,DIQ="TMP",DR=".01;1;2;3;4;5;6;7" D EN^DIQ1
|
|---|
| 8 | W @IOF,!!,?10,"This option will allow the user to open, close, or delete",!,?15,"a Patient Representative Contact record",!
|
|---|
| 9 | S N1="" F S N1=$O(TMP(745.1,N1)) Q:N1="" S N2="" F S N2=$O(TMP(745.1,N1,N2)) Q:N2="" S QACDATA=TMP(745.1,N1,N2) D
|
|---|
| 10 | .Q:QACDATA=""
|
|---|
| 11 | .S FLD=N2*100\1,TEXT=$P($T(@FLD),";;",2),TAB=$P(TEXT,"^"),LINE=$P(TEXT,"^",2),CODE=$P(TEXT,"^",3,99)
|
|---|
| 12 | .W:TAB=0 !
|
|---|
| 13 | .W ?TAB,LINE
|
|---|
| 14 | .X CODE
|
|---|
| 15 | .Q
|
|---|
| 16 | K TMP,DIQ,N1,N2,QACDATA,FLD,TAB,TEXT,LINE,CODE
|
|---|
| 17 | ;Ask what the user want to to with the record.
|
|---|
| 18 | S DIR(0)="SMO^O:Open;C:Closed;D:Delete",DIR("A")="STATUS",QACALERT=1
|
|---|
| 19 | S STAT=$P($G(^QA(745.1,DA,7)),"^",2),DIR("B")=$S(STAT="O":"Open",STAT="C":"Closed",1:"") D ^DIR G END:Y<0
|
|---|
| 20 | S LINE=$S(Y="O":"OPEN",Y="C":"CLOSE",Y="D":"DELE",1:"END") D @LINE
|
|---|
| 21 | G END
|
|---|
| 22 | OPEN S DR="27///^S X=""O"";26///^S X=""@""" D ^DIE K DR Q
|
|---|
| 23 | CLOSE S II=0 I $O(^QA(745.1,DA,3,II))']"" D
|
|---|
| 24 | . W !!?5,"Reports of Contact cannot be resolved without Issue Code(s)."
|
|---|
| 25 | . S QACIFLG=1
|
|---|
| 26 | S II=0 F S II=$O(^QA(745.1,DA,3,II)) Q:II'>0 D
|
|---|
| 27 | . S SS=0 I $O(^QA(745.1,DA,3,II,3,SS))']"" D
|
|---|
| 28 | . . W !!?5,"Reports of Contact cannot be resolved without a Service/Discipline",!?5,"for each Issue Code."
|
|---|
| 29 | . . S QACSFLG=1
|
|---|
| 30 | I $G(QACIFLG)=1!($G(QACSFLG)=1) K QACIFLG,QACSFLG Q
|
|---|
| 31 | S DR="26///TODAY" D ^DIE K DR Q
|
|---|
| 32 | DELE N DIR W !,*7,*7 S DIR("A")="SURE YOU WANT TO DELETE THE ENTIRE *"_$P(^QA(745.1,DA,0),"^",1)_"* CONSUMER CONTACT"
|
|---|
| 33 | S DIR(0)="Y" D ^DIR I Y'=1 W !,?30,"NOTHING DELETED" Q
|
|---|
| 34 | S DIK=DIC D ^DIK Q
|
|---|
| 35 | END K DIC,DIC,DIK,DIR,STAT,DR,DIE,DA,D0,DO,LINE,X,Y,%,%Y,D,DI,DQ,QACALERT
|
|---|
| 36 | Q
|
|---|
| 37 | TEXT ;This is for the display of data, tab,description,data info.
|
|---|
| 38 | 1 ;;0^Contact Number:^W ?21,QACDATA
|
|---|
| 39 | 100 ;;45^Date of Contact:^W ?63,QACDATA
|
|---|
| 40 | 200 ;;0^Patient Name:^W ?21,QACDATA
|
|---|
| 41 | 300 ;;45^Patient SSN (c):^W ?63,QACDATA
|
|---|
| 42 | 400 ;;0^Patient DOB (c):^S Y=QACDATA D DD^%DT S QACDATA=Y W ?21,QACDATA
|
|---|
| 43 | 500 ;;45^Patient sex (c):^W ?63,QACDATA
|
|---|
| 44 | 600 ;;0^Eligibility Status:^W ?21,QACDATA
|
|---|
| 45 | 700 ;;45^Patient Category:^W ?63,QACDATA
|
|---|
| 46 | Q
|
|---|
