Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACKQAS2

ACKQAS2.m

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