| [613] | 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
 | 
|---|