| 1 | QACEDIT ;HISC/RS,CEW,DAD - Edit routine for the Patient representative package ;3/21/95 10:18
|
|---|
| 2 | ;;2.0;Patient Representative;**3,5,10,17**;07/25/1995
|
|---|
| 3 | S (DIC,DIE)="^QA(745.1,",DIC(0)="AEMQZ",DIC("A")="Select CONTACT NUMBER: "
|
|---|
| 4 | S DIC("S")="I ($P($G(^QA(745.1,+Y,7)),""^"",2)=""O""),(($D(^XUSEC(""QAC EDIT"",DUZ))#2)!(DUZ=$P(^QA(745.1,+Y,0),U,7)))"
|
|---|
| 5 | D ^DIC I Y<0 K DIC,DIE Q
|
|---|
| 6 | ;DISPLAY CONTACT DATA NOT EDITABLE
|
|---|
| 7 | EDT ;Entry point for editing open ROCs on same patient from option 'Enter
|
|---|
| 8 | ;New Contact'
|
|---|
| 9 | N QACPSRV,QACGWV
|
|---|
| 10 | S RECNR=+Y L +^QA(745.1,RECNR):0 I '$T W !!,"Record being edited by another user." G END
|
|---|
| 11 | N QACPN S QACPN=$P(^QA(745.1,RECNR,0),U,3)
|
|---|
| 12 | K DA,DR,DIC,DIQ,TMP
|
|---|
| 13 | S DA=+Y,DIC=745.1,DIQ="TMP",DR=".01;1;2;3;4;5;6;7" D EN^DIQ1
|
|---|
| 14 | I '$G(QACFLG) W @IOF
|
|---|
| 15 | W !!,?15,"Edit Patient Representative Contact",!
|
|---|
| 16 | 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
|
|---|
| 17 | .Q:QACDATA=""
|
|---|
| 18 | .S FLD=N2*100\1,TEXT=$P($T(@FLD),";;",2),TAB=$P(TEXT,"^"),LINE=$P(TEXT,"^",2),CODE=$P(TEXT,"^",3,99)
|
|---|
| 19 | .W:TAB=0 !
|
|---|
| 20 | .W ?TAB,LINE
|
|---|
| 21 | .X CODE
|
|---|
| 22 | .Q
|
|---|
| 23 | I QACPN'="" S QACPSRV=$P($G(^DPT(QACPN,.32)),U,3),QACGWV=$P($G(^DPT(QACPN,.322)),U,10)
|
|---|
| 24 | S DIE="^QA(745.1,",DA=RECNR,DR="31////"_$G(QACPSRV)_";32////"_$G(QACGWV) D ^DIE
|
|---|
| 25 | I $G(QACPSRV)]"" W !,"Period of Service: ",?20,$P(^DIC(21,$G(QACPSRV),0),U)
|
|---|
| 26 | W ?47,"Persian Gulf War?:",?66,$S($G(QACGWV)="Y":"YES",$G(QACGWV)="N":"NO",$G(QACGWV)="U":"UNKNOWN",1:"Not Entered")
|
|---|
| 27 | ;I $P($G(^QA(745.1,RECNR,0)),U,16)]"" W !,"Division: ",?20,$P(^DIC(4,$P(^QA(745.1,RECNR,0),U,16),0),U)
|
|---|
| 28 | I $P($G(^QA(745.1,RECNR,0)),U,16)]"" D
|
|---|
| 29 | . S QAC1DIV=$P($G(^QA(745.1,RECNR,0)),U,16)
|
|---|
| 30 | . S QACDVNAM="" D INST^QACUTL0(QAC1DIV,.QACDVNAM)
|
|---|
| 31 | . W !,"Division: ",?20,QACDVNAM
|
|---|
| 32 | S DFN=$P(^QA(745.1,RECNR,0),U,3) I DFN'="" D DIS^DGRPDB
|
|---|
| 33 | K TMP,DIQ,N1,N2,QACDATA,FLD,TAB,TEXT,LINE,CODE
|
|---|
| 34 | ;Enter edit rest of the data
|
|---|
| 35 | EDIT ;
|
|---|
| 36 | N QACEE,QACLIST,QACNT S QACNT=0
|
|---|
| 37 | I QACPN'="" W ! S QACPN=$P($G(^QA(745.1,DA,0)),"^",3),QACALERT=1
|
|---|
| 38 | I $G(QACPN)]"" S DR=16.5 D ^DIE
|
|---|
| 39 | S DR="[QAC CONTACT ENTER/EDIT]"
|
|---|
| 40 | D ^DIE K DIE
|
|---|
| 41 | END L -^QA(745.1,RECNR)
|
|---|
| 42 | Q:$G(QACFLG)
|
|---|
| 43 | K DIC,DR,DIE,DA,D0,DO,QACPN,X,Y,RECNR,BY,DFN,DHD,DLAYGO,FLDS,FR,IOP,L
|
|---|
| 44 | K QACD1,QACDFLT,QACOUT,TO,QACALERT,QACDVNAM
|
|---|
| 45 | W !! G ^QACEDIT
|
|---|
| 46 | TEXT ;This is for the display of data, tab, description, data info.
|
|---|
| 47 | 1 ;;0^Contact Number:^W ?20,QACDATA
|
|---|
| 48 | 100 ;;47^Date of Contact:^W ?66,QACDATA
|
|---|
| 49 | 200 ;;0^Patient Name:^W ?20,QACDATA
|
|---|
| 50 | 300 ;;47^Patient SSN (c):^W ?66,QACDATA
|
|---|
| 51 | 400 ;;0^Patient DOB (c):^S Y=QACDATA D DD^%DT S QACDATA=Y W ?20,QACDATA
|
|---|
| 52 | 500 ;;47^Patient sex (c):^W ?66,QACDATA
|
|---|
| 53 | 600 ;;0^Eligibility Status:^W ?20,QACDATA
|
|---|
| 54 | 700 ;;47^Patient Category:^W ?66,QACDATA
|
|---|
| 55 | 3100 ;;0^Period of Service:^W ?20,$P(^DIC(21,$G(QACDATA),0),U)
|
|---|
| 56 | Q
|
|---|
| 57 | IDSPLAY ;If the site wants to display the Issue Codes and Services
|
|---|
| 58 | ;IDSPLAY is used. See Site Parameters.
|
|---|
| 59 | W !!,?10,"Previously Entered Issue Codes:",!!
|
|---|
| 60 | I $O(^QA(745.1,DA,3,0)) S QACNUM=DA D CODES^QACNEW
|
|---|
| 61 | I '$O(^QA(745.1,DA,3,0)) W ?3,"None!",!
|
|---|
| 62 | ;. S DIC="^QA(745.1,",L=0,DHD="@@"
|
|---|
| 63 | ;. S FLDS="21,.01;C3;L60,"" (*"",:745.2:7,"")""1,.01;C10,",BY="@NUMBER",(FR,TO)=DA
|
|---|
| 64 | ;. S IOP="HOME" D EN1^DIP
|
|---|
| 65 | ;E W ?3,"None!",!
|
|---|
| 66 | Q
|
|---|
