ACKQAS2 ;HCIOFO/BH-Edit an Existing Visit ; 04/01/99
;;3.0;QUASAR;;Feb 11, 2000
;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
OPTN ; Introduce option.
;
W @IOF D HEADING
;
VEDIT ; EDIT AN EXISTING VISIT
;
DATE ; Enter date
S ACKVISIT="EDIT"
W !
S DIC("W")="W $$DISPLAY^ACKQUTL3(Y,$X)"
S DIC=509850.6,DIC(0)="AEMQZ" D ^DIC
I X?1"^"1.E W !,"Jumping not allowed.",! G DATE
G:Y<0 VEXIT
;
S ACKY=+Y,ACKVD=$P(Y,U,2),DFN=$P(Y(0),U,2)
S ACKVIEN=+Y
;
; Check Visit Date Okay
S ACKQDTE=$$GET1^DIQ(509850.6,ACKVIEN,.01,"E")
RES W !,"DATE: "_ACKQDTE_"//" R ACKQRES:DTIME
I ACKQRES="^" G DATE
I ACKQRES'="" W !!,"Enter <RETURN> to continue or '^' to Quit.",! G RES
;
; Attempt to Lock record if lock display error and re-promt
L +^ACK(509850.6,ACKVIEN):2 E W !!,"This record is locked by another process - Please try again later.",!! G DATE
;
; Check to see if PCE data has got out of set with Quasar data
I $$GET1^DIQ(509850.6,ACKVIEN,"125","I")'="" I '$$DATACHK^ACKQASU3(ACKVIEN) D UNLOCK,VEXIT,HEADING G DATE
;
S (ACKPAT,ACKDFN)=DFN
S ACKCLIN=$$GET1^DIQ(509850.6,ACKVIEN,"2.6","I")
S ACKCSC=$$GET1^DIQ(509850.6,ACKVIEN,"4","I")
S ACKDIV=$$GET1^DIQ(509850.6,ACKVIEN,"60","I")
S ACKVTME=$$GET1^DIQ(509850.6,ACKVIEN,55,"I"),ACKVTME=$P(ACKVTME,".",2)
S ACKPCE=$$PCE^ACKQUTL4(ACKDIV,ACKVD)
;
;
I 'ACKCLIN!(ACKCSC="") W !,"No clinic or Clinic Stop Code set up for original visit" D UNLOCK G VEXIT
;
SUPER ; Staff designated as supervisors can edit/delete .01 field.
; I $D(^ACK(509850.3,DUZ,0)) I $P(^(0),"^",6)=1 D I $D(DIRUT)!($D(DTOUT)) D UNLOCK G VEXIT
; .K DIRUT,DTOUT,X,Y S DIE=DIC,DA=ACKY,DR=".01" D ^DIE Q:$D(DTOUT)
; .I ('$D(DA))!($D(Y)) S DIRUT="" Q
; .S ACKVD=$P(^ACK(509850.6,ACKY,0),"^")
;
;
TPLATE S DIE=DIC,DA=ACKY,DR="[ACKQAS VISIT ENTRY]" D ^DIE
D UTLAUD^ACKQASU2
S ACKQTST=$$POST^ACKQASU2(ACKVIEN) I 'ACKQTST S ACKDFN=DFN G TPLATE
; ACKQTST will equal 1 (Visit okay or user chose to continue) or
; ACKQTST will equal 2 the visit has been deleted
I ACKPCE,ACKQTST=1,$$EXPT^ACKQASU2(ACKVIEN) I '$$PCESEND^ACKQASU3(ACKVIEN) S ACKDFN=DFN G TPLATE
; If visit is okay and visit not to be sent to PCE but visit has a
; value in the PCE IEN field - the EXCEPTION DATE from the visit is
; used to check the Exception cross reference. If an exception exists
; display a warning message.
I ACKQTST=1,'ACKPCE,$$GET1^DIQ(509850.6,ACKVIEN_",",125,"I")'="" D
. Q:'$$EXPT^ACKQASU2(ACKVIEN)
. D EXCEPT^ACKQASU1
; Unlock - Kill off old vars. - re-display heading and return to start
D UNLOCK,VEXIT,HEADING G VEDIT
;
VEXIT K ACK0,ACK2,ACKCAT,ACKCD,ACKCDN,ACKCLN,ACKCNT,ACKCP,ACKDA,ACKDC,ACKDUP
K ACKDUPN,ACKECSC,ACKESITE,ACKFLD,ACKFLG1,ACKFLG2,ACKGEN,ACKI,ACKLAYGO
K ACKMOD,ACKMON,ACKQCPS,ACKQCPT,ACKQRAW,ACKRAW,ACKREQ,ACKSEL,ACKSTF
K ACKSIG,ACKTM,ACKVD,ACKDIRUT,VADM,ACKLAMD,ACKVISIT,ACKQDTE,ACKQRES
K %,%DT,%I,%X,%Y,C,D0,DA,DFN,DIC,DIE,DIK,DIRUT,DLAYGO,DR,DTOUT,I,J,X,Y
K ACKCHK,ACKAO,ACKSC,ACKRAD,ACKENV,ACKCP,ACKELIG,ACKVELIG,ACKEGCT
K ACKATS,ACKBA,ACKCLIN,ACKCLNO,ACKDIV,ACKELDIS,ACKELGCT,ACKK2,ACKLOSS
K ACKPAT,ACKPCE,ACKVELG,ACKVIEN,ACKY,ACKCPNO,ACKQTST
K ACKQSER,ACKQORG,ACKQIR,ACKQECON
D KILL^%ZISS
Q
;
UNLOCK ; Unlock locked record
L
Q
;
HEADING ;
W @IOF
W !!,"This option is used to modify an existing clinic visit when the data is",!,"incorrect, incomplete, or needs to be updated.",!!
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HACKQAS2 3484 printed Jun 11, 2024@22:17:55 Page 2
ACKQAS2 ;HCIOFO/BH-Edit an Existing Visit ; 04/01/99
+1 ;;3.0;QUASAR;;Feb 11, 2000
+2 ;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
OPTN ; Introduce option.
+1 ;
+2 WRITE @IOF
DO HEADING
+3 ;
VEDIT ; EDIT AN EXISTING VISIT
+1 ;
DATE ; Enter date
+1 SET ACKVISIT="EDIT"
+2 WRITE !
+3 SET DIC("W")="W $$DISPLAY^ACKQUTL3(Y,$X)"
+4 SET DIC=509850.6
SET DIC(0)="AEMQZ"
DO ^DIC
+5 IF X?1"^"1.E
WRITE !,"Jumping not allowed.",!
GOTO DATE
+6 if Y<0
GOTO VEXIT
+7 ;
+8 SET ACKY=+Y
SET ACKVD=$PIECE(Y,U,2)
SET DFN=$PIECE(Y(0),U,2)
+9 SET ACKVIEN=+Y
+10 ;
+11 ; Check Visit Date Okay
+12 SET ACKQDTE=$$GET1^DIQ(509850.6,ACKVIEN,.01,"E")
RES WRITE !,"DATE: "_ACKQDTE_"//"
READ ACKQRES:DTIME
+1 IF ACKQRES="^"
GOTO DATE
+2 IF ACKQRES'=""
WRITE !!,"Enter <RETURN> to continue or '^' to Quit.",!
GOTO RES
+3 ;
+4 ; Attempt to Lock record if lock display error and re-promt
+5 LOCK +^ACK(509850.6,ACKVIEN):2
IF '$TEST
WRITE !!,"This record is locked by another process - Please try again later.",!!
GOTO DATE
+6 ;
+7 ; Check to see if PCE data has got out of set with Quasar data
+8 IF $$GET1^DIQ(509850.6,ACKVIEN,"125","I")'=""
IF '$$DATACHK^ACKQASU3(ACKVIEN)
DO UNLOCK
DO VEXIT
DO HEADING
GOTO DATE
+9 ;
+10 SET (ACKPAT,ACKDFN)=DFN
+11 SET ACKCLIN=$$GET1^DIQ(509850.6,ACKVIEN,"2.6","I")
+12 SET ACKCSC=$$GET1^DIQ(509850.6,ACKVIEN,"4","I")
+13 SET ACKDIV=$$GET1^DIQ(509850.6,ACKVIEN,"60","I")
+14 SET ACKVTME=$$GET1^DIQ(509850.6,ACKVIEN,55,"I")
SET ACKVTME=$PIECE(ACKVTME,".",2)
+15 SET ACKPCE=$$PCE^ACKQUTL4(ACKDIV,ACKVD)
+16 ;
+17 ;
+18 IF 'ACKCLIN!(ACKCSC="")
WRITE !,"No clinic or Clinic Stop Code set up for original visit"
DO UNLOCK
GOTO VEXIT
+19 ;
SUPER ; Staff designated as supervisors can edit/delete .01 field.
+1 ; I $D(^ACK(509850.3,DUZ,0)) I $P(^(0),"^",6)=1 D I $D(DIRUT)!($D(DTOUT)) D UNLOCK G VEXIT
+2 ; .K DIRUT,DTOUT,X,Y S DIE=DIC,DA=ACKY,DR=".01" D ^DIE Q:$D(DTOUT)
+3 ; .I ('$D(DA))!($D(Y)) S DIRUT="" Q
+4 ; .S ACKVD=$P(^ACK(509850.6,ACKY,0),"^")
+5 ;
+6 ;
TPLATE SET DIE=DIC
SET DA=ACKY
SET DR="[ACKQAS VISIT ENTRY]"
DO ^DIE
+1 DO UTLAUD^ACKQASU2
+2 SET ACKQTST=$$POST^ACKQASU2(ACKVIEN)
IF 'ACKQTST
SET ACKDFN=DFN
GOTO TPLATE
+3 ; ACKQTST will equal 1 (Visit okay or user chose to continue) or
+4 ; ACKQTST will equal 2 the visit has been deleted
+5 IF ACKPCE
IF ACKQTST=1
IF $$EXPT^ACKQASU2(ACKVIEN)
IF '$$PCESEND^ACKQASU3(ACKVIEN)
SET ACKDFN=DFN
GOTO TPLATE
+6 ; If visit is okay and visit not to be sent to PCE but visit has a
+7 ; value in the PCE IEN field - the EXCEPTION DATE from the visit is
+8 ; used to check the Exception cross reference. If an exception exists
+9 ; display a warning message.
+10 IF ACKQTST=1
IF 'ACKPCE
IF $$GET1^DIQ(509850.6,ACKVIEN_",",125,"I")'=""
Begin DoDot:1
+11 if '$$EXPT^ACKQASU2(ACKVIEN)
QUIT
+12 DO EXCEPT^ACKQASU1
End DoDot:1
+13 ; Unlock - Kill off old vars. - re-display heading and return to start
+14 DO UNLOCK
DO VEXIT
DO HEADING
GOTO VEDIT
+15 ;
VEXIT KILL ACK0,ACK2,ACKCAT,ACKCD,ACKCDN,ACKCLN,ACKCNT,ACKCP,ACKDA,ACKDC,ACKDUP
+1 KILL ACKDUPN,ACKECSC,ACKESITE,ACKFLD,ACKFLG1,ACKFLG2,ACKGEN,ACKI,ACKLAYGO
+2 KILL ACKMOD,ACKMON,ACKQCPS,ACKQCPT,ACKQRAW,ACKRAW,ACKREQ,ACKSEL,ACKSTF
+3 KILL ACKSIG,ACKTM,ACKVD,ACKDIRUT,VADM,ACKLAMD,ACKVISIT,ACKQDTE,ACKQRES
+4 KILL %,%DT,%I,%X,%Y,C,D0,DA,DFN,DIC,DIE,DIK,DIRUT,DLAYGO,DR,DTOUT,I,J,X,Y
+5 KILL ACKCHK,ACKAO,ACKSC,ACKRAD,ACKENV,ACKCP,ACKELIG,ACKVELIG,ACKEGCT
+6 KILL ACKATS,ACKBA,ACKCLIN,ACKCLNO,ACKDIV,ACKELDIS,ACKELGCT,ACKK2,ACKLOSS
+7 KILL ACKPAT,ACKPCE,ACKVELG,ACKVIEN,ACKY,ACKCPNO,ACKQTST
+8 KILL ACKQSER,ACKQORG,ACKQIR,ACKQECON
+9 DO KILL^%ZISS
+10 QUIT
+11 ;
UNLOCK ; Unlock locked record
+1 LOCK
+2 QUIT
+3 ;
HEADING ;
+1 WRITE @IOF
+2 WRITE !!,"This option is used to modify an existing clinic visit when the data is",!,"incorrect, incomplete, or needs to be updated.",!!
+3 QUIT
+4 ;
