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

ACKQAS4.m

Go to the documentation of this file. 
  1. ACKQAS4 ;HCIOFO/AG - Delete a Quasar 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.  ;
  1.  N DIC,X,Y,ACKVIEN,DFN,ACKPAT,VADM,ACKPATNM,ACKPATSS,ACKCLNNM,ACKDIVNM
  1.  N ACKDATE,ACKTM,ACKTIME,ACKPIEN,ACKP,ACKIFACE,ACKPCES,ACKDIV,ACKVDT
  1.  N ACKPCED,ACKPCEDT,DIR,ACKOK,ACKARR
  1.  ;
  1. OPTN ;  Introduce option.
  1.  W @IOF
  1.  W !!,"This option is used to DELETE an existing A&SP Clinic Visit.",!!
  1.  ;
  1. DATE ;  Enter date
  1.  W !
  1.  S DIC("W")="W $$DISPLAY^ACKQUTL3(Y,$X)"
  1.  S DIC=509850.6,DIC(0)="AEQZ" D ^DIC
  1.  I X?1"^"1.E W !,"Jumping not allowed.",! G DATE
  1.  G:Y<0 EXIT
  1.  G:$D(DIRUT) EXIT
  1.  ;
  1.  ; set visit ien variable
  1.  S ACKVIEN=+Y
  1.  ;
  1.  ; Attempt to Lock record if lock fails display error and re-prompt
  1.  L +^ACK(509850.6,ACKVIEN):2 I '$T D  G DATE
  1.  . W !!,"This record is locked by another process - Please try again later.",!!
  1.  ;
  1.  ; display summary details about the visit
  1.  S (DFN,ACKPAT)=+$$GET1^DIQ(509850.6,ACKVIEN_",",1,"I")
  1.  D DEM^VADPT
  1.  S ACKPATNM=VADM(1)
  1.  S ACKPATSS=$P(VADM(2),U,2)
  1.  S ACKCLNNM=$$GET1^DIQ(509850.6,ACKVIEN_",",2.6,"E") ; clinic external
  1.  S ACKDIVNM=$$GET1^DIQ(509850.6,ACKVIEN_",",60,"E")  ; division external
  1.  S ACKDATE=$$GET1^DIQ(509850.6,ACKVIEN_",",.01,"E")  ; date external
  1.  S ACKTM=$$GET1^DIQ(509850.6,ACKVIEN_",",55,"I"),ACKTIME=$$FMT^ACKQUTL6(ACKTM,0)
  1.  S ACKPIEN=$$GET1^DIQ(509850.6,ACKVIEN_",",125,"I")  ; pce visit ien
  1.  S ACKP=$S(ACKPIEN:".",1:"") ; pce flag
  1.  W !!?2," Patient: ",$E(ACKPATNM,1,35)
  1.  W ?48,"             SSN: ",ACKPATSS
  1.  W !?2,"  Clinic: ",$E(ACKCLNNM,1,35)
  1.  W ?48,"      Visit Date: ",$E(ACKDATE,1,12)
  1.  W !?2,"Division: ",$E(ACKDIVNM,1,35)
  1.  W ?48,"Appointment Time: ",ACKTIME_ACKP
  1.  W !
  1.  ;
  1.  ; determine whether the PCE Interface is ON
  1.  S ACKIFACE=0
  1.  S ACKPCES=$$GET1^DIQ(509850.8,"1,",2,"I")
  1.  S ACKDIV=$$GET1^DIQ(509850.6,ACKVIEN_",",60,"I")
  1.  S ACKVDT=$$GET1^DIQ(509850.6,ACKVIEN_",",.01,"I")
  1.  S ACKPCED=$$GET1^DIQ(509850.83,ACKDIV_",1,",.03,"I")
  1.  S ACKPCEDT=$$GET1^DIQ(509850.83,ACKDIV_",1,",.08,"I")
  1.  ; if Site switch is ON and Division switch is ON and Visit Date is
  1.  ;  after PCE Interface Start Date, then Interface is ON.
  1.  I ACKPCES=1,ACKPCED=1,ACKVDT'<ACKPCEDT S ACKIFACE=1
  1.  ;
  1.  ; if interface is not on, but visit has a PCE Visit IEN, then display warning
  1.  I ACKIFACE=0,ACKPIEN D WARNING
  1.  ;
  1. DELETE ; ask user to confirm the deletion
  1.  S DIR(0)="Y",DIR("B")="NO"
  1.  S DIR("A")="Do you wish to DELETE this Visit from QUASAR"
  1.  D ^DIR
  1.  I $D(DTOUT) G EXIT   ; timed out
  1.  I $D(DUOUT) G EXIT   ; user exited
  1.  I Y?1"^"1.E W !,"Jumping not allowed.",! G DELETE
  1.  I Y=0 G EXIT         ; user chose not to delete
  1.  W !
  1.  ;
  1.  ; if the interface is not on, or the visit does not exist in PCE
  1.  ;  then proceed with deletion from QUASAR
  1.  I (ACKIFACE=0)!('ACKPIEN) G DOIT
  1.  ;
  1. DELPCE ; call the function to delete the visit from PCE
  1.  S ACKOK=$$KILLPCE^ACKQPCE(ACKVIEN)
  1.  ;
  1.  ; if deletion succeeded then jump to deletion point
  1.  I ACKOK G DOIT
  1.  ;
  1. FAILED ; if deletion failed then display errors
  1.  W !!?2,"ERROR: The PCE Visit linked to this QUASAR Visit could not be deleted."
  1.  W !!?2,"If you choose to continue, the QUASAR visit will be deleted but the PCE Visit"
  1.  W !?2,"will remain. Corrective action to the PCE Visit will be required using the"
  1.  W !?2,"PCE System.",!
  1.  ;
  1. CONFIRM ; prompt whether to continue
  1.  S DIR(0)="Y",DIR("B")="NO"
  1.  S DIR("A")="Do you wish to DELETE just the QUASAR Visit"
  1.  D ^DIR
  1.  I $D(DTOUT) G EXIT   ; timed out
  1.  I $D(DUOUT) G EXIT   ; user exited
  1.  I Y?1"^"1.E W !,"Jumping not allowed.",! G CONFIRM
  1.  I Y=0 G EXIT         ; user chose to exit
  1.  ;
  1. DOIT ; ok - delete the visit from Quasar
  1.  K ACKARR
  1.  S ACKARR(509850.6,ACKVIEN_",",.01)="@"
  1.  D FILE^DIE("","ACKARR","")
  1.  W !?10,"* * * Visit deleted from QUASAR. * * *",!
  1.  ; now update the problem list for the patient
  1.  D PROBLIST^ACKQUTL3(ACKPAT,1)
  1.  ;
  1.  ; all done
  1. EXIT ;
  1.  ; unlock
  1.  L
  1.  ;
  1.  ; clean up all variables
  1.  K DIC,Y,ACKVIEN,DFN,ACKPAT,ACKPATSS,VADM,ACKPATNM,ACKCLNNM,ACKDIVNM
  1.  K ACKDATE,ACKTM,ACKTIME,DIR,ACKOK,ACKARR,ACKP
  1.  Q
  1.  ;
  1. WARNING ; display a warning to the user that the interface is not on so this
  1.  ; deletion will not be replicated in the PCE database.
  1.  W !?2,"WARNING - This QUASAR Visit is linked to a PCE Visit but the PCE Interface"
  1.  W !?2,"is not active. If you delete this visit, it will be deleted from QUASAR but"
  1.  W !?2,"the corresponding PCE Visit will remain. To delete the visit from PCE you"
  1.  W !?2,"must use the PCE package options.",!
  1.  Q
  1.  ;