| 1 | ACKQAS2 ;HCIOFO/BH-Edit an Existing Visit ; 04/01/99
|
|---|
| 2 | ;;3.0;QUASAR;;Feb 11, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
|
|---|
| 4 | OPTN ; Introduce option.
|
|---|
| 5 | ;
|
|---|
| 6 | W @IOF D HEADING
|
|---|
| 7 | ;
|
|---|
| 8 | VEDIT ; EDIT AN EXISTING VISIT
|
|---|
| 9 | ;
|
|---|
| 10 | DATE ; Enter date
|
|---|
| 11 | S ACKVISIT="EDIT"
|
|---|
| 12 | W !
|
|---|
| 13 | S DIC("W")="W $$DISPLAY^ACKQUTL3(Y,$X)"
|
|---|
| 14 | S DIC=509850.6,DIC(0)="AEMQZ" D ^DIC
|
|---|
| 15 | I X?1"^"1.E W !,"Jumping not allowed.",! G DATE
|
|---|
| 16 | G:Y<0 VEXIT
|
|---|
| 17 | ;
|
|---|
| 18 | S ACKY=+Y,ACKVD=$P(Y,U,2),DFN=$P(Y(0),U,2)
|
|---|
| 19 | S ACKVIEN=+Y
|
|---|
| 20 | ;
|
|---|
| 21 | ; Check Visit Date Okay
|
|---|
| 22 | S ACKQDTE=$$GET1^DIQ(509850.6,ACKVIEN,.01,"E")
|
|---|
| 23 | RES W !,"DATE: "_ACKQDTE_"//" R ACKQRES:DTIME
|
|---|
| 24 | I ACKQRES="^" G DATE
|
|---|
| 25 | I ACKQRES'="" W !!,"Enter <RETURN> to continue or '^' to Quit.",! G RES
|
|---|
| 26 | ;
|
|---|
| 27 | ; Attempt to Lock record if lock display error and re-promt
|
|---|
| 28 | L +^ACK(509850.6,ACKVIEN):2 E W !!,"This record is locked by another process - Please try again later.",!! G DATE
|
|---|
| 29 | ;
|
|---|
| 30 | ; Check to see if PCE data has got out of set with Quasar data
|
|---|
| 31 | I $$GET1^DIQ(509850.6,ACKVIEN,"125","I")'="" I '$$DATACHK^ACKQASU3(ACKVIEN) D UNLOCK,VEXIT,HEADING G DATE
|
|---|
| 32 | ;
|
|---|
| 33 | S (ACKPAT,ACKDFN)=DFN
|
|---|
| 34 | S ACKCLIN=$$GET1^DIQ(509850.6,ACKVIEN,"2.6","I")
|
|---|
| 35 | S ACKCSC=$$GET1^DIQ(509850.6,ACKVIEN,"4","I")
|
|---|
| 36 | S ACKDIV=$$GET1^DIQ(509850.6,ACKVIEN,"60","I")
|
|---|
| 37 | S ACKVTME=$$GET1^DIQ(509850.6,ACKVIEN,55,"I"),ACKVTME=$P(ACKVTME,".",2)
|
|---|
| 38 | S ACKPCE=$$PCE^ACKQUTL4(ACKDIV,ACKVD)
|
|---|
| 39 | ;
|
|---|
| 40 | ;
|
|---|
| 41 | I 'ACKCLIN!(ACKCSC="") W !,"No clinic or Clinic Stop Code set up for original visit" D UNLOCK G VEXIT
|
|---|
| 42 | ;
|
|---|
| 43 | SUPER ; Staff designated as supervisors can edit/delete .01 field.
|
|---|
| 44 | ; I $D(^ACK(509850.3,DUZ,0)) I $P(^(0),"^",6)=1 D I $D(DIRUT)!($D(DTOUT)) D UNLOCK G VEXIT
|
|---|
| 45 | ; .K DIRUT,DTOUT,X,Y S DIE=DIC,DA=ACKY,DR=".01" D ^DIE Q:$D(DTOUT)
|
|---|
| 46 | ; .I ('$D(DA))!($D(Y)) S DIRUT="" Q
|
|---|
| 47 | ; .S ACKVD=$P(^ACK(509850.6,ACKY,0),"^")
|
|---|
| 48 | ;
|
|---|
| 49 | ;
|
|---|
| 50 | TPLATE S DIE=DIC,DA=ACKY,DR="[ACKQAS VISIT ENTRY]" D ^DIE
|
|---|
| 51 | D UTLAUD^ACKQASU2
|
|---|
| 52 | S ACKQTST=$$POST^ACKQASU2(ACKVIEN) I 'ACKQTST S ACKDFN=DFN G TPLATE
|
|---|
| 53 | ; ACKQTST will equal 1 (Visit okay or user chose to continue) or
|
|---|
| 54 | ; ACKQTST will equal 2 the visit has been deleted
|
|---|
| 55 | I ACKPCE,ACKQTST=1,$$EXPT^ACKQASU2(ACKVIEN) I '$$PCESEND^ACKQASU3(ACKVIEN) S ACKDFN=DFN G TPLATE
|
|---|
| 56 | ; If visit is okay and visit not to be sent to PCE but visit has a
|
|---|
| 57 | ; value in the PCE IEN field - the EXCEPTION DATE from the visit is
|
|---|
| 58 | ; used to check the Exception cross reference. If an exception exists
|
|---|
| 59 | ; display a warning message.
|
|---|
| 60 | I ACKQTST=1,'ACKPCE,$$GET1^DIQ(509850.6,ACKVIEN_",",125,"I")'="" D
|
|---|
| 61 | . Q:'$$EXPT^ACKQASU2(ACKVIEN)
|
|---|
| 62 | . D EXCEPT^ACKQASU1
|
|---|
| 63 | ; Unlock - Kill off old vars. - re-display heading and return to start
|
|---|
| 64 | D UNLOCK,VEXIT,HEADING G VEDIT
|
|---|
| 65 | ;
|
|---|
| 66 | VEXIT K ACK0,ACK2,ACKCAT,ACKCD,ACKCDN,ACKCLN,ACKCNT,ACKCP,ACKDA,ACKDC,ACKDUP
|
|---|
| 67 | K ACKDUPN,ACKECSC,ACKESITE,ACKFLD,ACKFLG1,ACKFLG2,ACKGEN,ACKI,ACKLAYGO
|
|---|
| 68 | K ACKMOD,ACKMON,ACKQCPS,ACKQCPT,ACKQRAW,ACKRAW,ACKREQ,ACKSEL,ACKSTF
|
|---|
| 69 | K ACKSIG,ACKTM,ACKVD,ACKDIRUT,VADM,ACKLAMD,ACKVISIT,ACKQDTE,ACKQRES
|
|---|
| 70 | K %,%DT,%I,%X,%Y,C,D0,DA,DFN,DIC,DIE,DIK,DIRUT,DLAYGO,DR,DTOUT,I,J,X,Y
|
|---|
| 71 | K ACKCHK,ACKAO,ACKSC,ACKRAD,ACKENV,ACKCP,ACKELIG,ACKVELIG,ACKEGCT
|
|---|
| 72 | K ACKATS,ACKBA,ACKCLIN,ACKCLNO,ACKDIV,ACKELDIS,ACKELGCT,ACKK2,ACKLOSS
|
|---|
| 73 | K ACKPAT,ACKPCE,ACKVELG,ACKVIEN,ACKY,ACKCPNO,ACKQTST
|
|---|
| 74 | K ACKQSER,ACKQORG,ACKQIR,ACKQECON
|
|---|
| 75 | D KILL^%ZISS
|
|---|
| 76 | Q
|
|---|
| 77 | ;
|
|---|
| 78 | UNLOCK ; Unlock locked record
|
|---|
| 79 | L
|
|---|
| 80 | Q
|
|---|
| 81 | ;
|
|---|
| 82 | HEADING ;
|
|---|
| 83 | W @IOF
|
|---|
| 84 | W !!,"This option is used to modify an existing clinic visit when the data is",!,"incorrect, incomplete, or needs to be updated.",!!
|
|---|
| 85 | Q
|
|---|
| 86 | ;
|
|---|
