ACKQAS4 ;HCIOFO/AG - Delete a Quasar Visit ; 04/01/99
;;3.0;QUASAR;;Feb 11, 2000
;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
;
N DIC,X,Y,ACKVIEN,DFN,ACKPAT,VADM,ACKPATNM,ACKPATSS,ACKCLNNM,ACKDIVNM
N ACKDATE,ACKTM,ACKTIME,ACKPIEN,ACKP,ACKIFACE,ACKPCES,ACKDIV,ACKVDT
N ACKPCED,ACKPCEDT,DIR,ACKOK,ACKARR
;
OPTN ; Introduce option.
W @IOF
W !!,"This option is used to DELETE an existing A&SP Clinic Visit.",!!
;
DATE ; Enter date
W !
S DIC("W")="W $$DISPLAY^ACKQUTL3(Y,$X)"
S DIC=509850.6,DIC(0)="AEQZ" D ^DIC
I X?1"^"1.E W !,"Jumping not allowed.",! G DATE
G:Y<0 EXIT
G:$D(DIRUT) EXIT
;
; set visit ien variable
S ACKVIEN=+Y
;
; Attempt to Lock record if lock fails display error and re-prompt
L +^ACK(509850.6,ACKVIEN):2 I '$T D G DATE
. W !!,"This record is locked by another process - Please try again later.",!!
;
; display summary details about the visit
S (DFN,ACKPAT)=+$$GET1^DIQ(509850.6,ACKVIEN_",",1,"I")
D DEM^VADPT
S ACKPATNM=VADM(1)
S ACKPATSS=$P(VADM(2),U,2)
S ACKCLNNM=$$GET1^DIQ(509850.6,ACKVIEN_",",2.6,"E") ; clinic external
S ACKDIVNM=$$GET1^DIQ(509850.6,ACKVIEN_",",60,"E") ; division external
S ACKDATE=$$GET1^DIQ(509850.6,ACKVIEN_",",.01,"E") ; date external
S ACKTM=$$GET1^DIQ(509850.6,ACKVIEN_",",55,"I"),ACKTIME=$$FMT^ACKQUTL6(ACKTM,0)
S ACKPIEN=$$GET1^DIQ(509850.6,ACKVIEN_",",125,"I") ; pce visit ien
S ACKP=$S(ACKPIEN:".",1:"") ; pce flag
W !!?2," Patient: ",$E(ACKPATNM,1,35)
W ?48," SSN: ",ACKPATSS
W !?2," Clinic: ",$E(ACKCLNNM,1,35)
W ?48," Visit Date: ",$E(ACKDATE,1,12)
W !?2,"Division: ",$E(ACKDIVNM,1,35)
W ?48,"Appointment Time: ",ACKTIME_ACKP
W !
;
; determine whether the PCE Interface is ON
S ACKIFACE=0
S ACKPCES=$$GET1^DIQ(509850.8,"1,",2,"I")
S ACKDIV=$$GET1^DIQ(509850.6,ACKVIEN_",",60,"I")
S ACKVDT=$$GET1^DIQ(509850.6,ACKVIEN_",",.01,"I")
S ACKPCED=$$GET1^DIQ(509850.83,ACKDIV_",1,",.03,"I")
S ACKPCEDT=$$GET1^DIQ(509850.83,ACKDIV_",1,",.08,"I")
; if Site switch is ON and Division switch is ON and Visit Date is
; after PCE Interface Start Date, then Interface is ON.
I ACKPCES=1,ACKPCED=1,ACKVDT'<ACKPCEDT S ACKIFACE=1
;
; if interface is not on, but visit has a PCE Visit IEN, then display warning
I ACKIFACE=0,ACKPIEN D WARNING
;
DELETE ; ask user to confirm the deletion
S DIR(0)="Y",DIR("B")="NO"
S DIR("A")="Do you wish to DELETE this Visit from QUASAR"
D ^DIR
I $D(DTOUT) G EXIT ; timed out
I $D(DUOUT) G EXIT ; user exited
I Y?1"^"1.E W !,"Jumping not allowed.",! G DELETE
I Y=0 G EXIT ; user chose not to delete
W !
;
; if the interface is not on, or the visit does not exist in PCE
; then proceed with deletion from QUASAR
I (ACKIFACE=0)!('ACKPIEN) G DOIT
;
DELPCE ; call the function to delete the visit from PCE
S ACKOK=$$KILLPCE^ACKQPCE(ACKVIEN)
;
; if deletion succeeded then jump to deletion point
I ACKOK G DOIT
;
FAILED ; if deletion failed then display errors
W !!?2,"ERROR: The PCE Visit linked to this QUASAR Visit could not be deleted."
W !!?2,"If you choose to continue, the QUASAR visit will be deleted but the PCE Visit"
W !?2,"will remain. Corrective action to the PCE Visit will be required using the"
W !?2,"PCE System.",!
;
CONFIRM ; prompt whether to continue
S DIR(0)="Y",DIR("B")="NO"
S DIR("A")="Do you wish to DELETE just the QUASAR Visit"
D ^DIR
I $D(DTOUT) G EXIT ; timed out
I $D(DUOUT) G EXIT ; user exited
I Y?1"^"1.E W !,"Jumping not allowed.",! G CONFIRM
I Y=0 G EXIT ; user chose to exit
;
DOIT ; ok - delete the visit from Quasar
K ACKARR
S ACKARR(509850.6,ACKVIEN_",",.01)="@"
D FILE^DIE("","ACKARR","")
W !?10,"* * * Visit deleted from QUASAR. * * *",!
; now update the problem list for the patient
D PROBLIST^ACKQUTL3(ACKPAT,1)
;
; all done
EXIT ;
; unlock
L
;
; clean up all variables
K DIC,Y,ACKVIEN,DFN,ACKPAT,ACKPATSS,VADM,ACKPATNM,ACKCLNNM,ACKDIVNM
K ACKDATE,ACKTM,ACKTIME,DIR,ACKOK,ACKARR,ACKP
Q
;
WARNING ; display a warning to the user that the interface is not on so this
; deletion will not be replicated in the PCE database.
W !?2,"WARNING - This QUASAR Visit is linked to a PCE Visit but the PCE Interface"
W !?2,"is not active. If you delete this visit, it will be deleted from QUASAR but"
W !?2,"the corresponding PCE Visit will remain. To delete the visit from PCE you"
W !?2,"must use the PCE package options.",!
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HACKQAS4 4527 printed Dec 13, 2024@02:31:44 Page 2
ACKQAS4 ;HCIOFO/AG - Delete a Quasar Visit ; 04/01/99
+1 ;;3.0;QUASAR;;Feb 11, 2000
+2 ;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
+3 ;
+4 NEW DIC,X,Y,ACKVIEN,DFN,ACKPAT,VADM,ACKPATNM,ACKPATSS,ACKCLNNM,ACKDIVNM
+5 NEW ACKDATE,ACKTM,ACKTIME,ACKPIEN,ACKP,ACKIFACE,ACKPCES,ACKDIV,ACKVDT
+6 NEW ACKPCED,ACKPCEDT,DIR,ACKOK,ACKARR
+7 ;
OPTN ; Introduce option.
+1 WRITE @IOF
+2 WRITE !!,"This option is used to DELETE an existing A&SP Clinic Visit.",!!
+3 ;
DATE ; Enter date
+1 WRITE !
+2 SET DIC("W")="W $$DISPLAY^ACKQUTL3(Y,$X)"
+3 SET DIC=509850.6
SET DIC(0)="AEQZ"
DO ^DIC
+4 IF X?1"^"1.E
WRITE !,"Jumping not allowed.",!
GOTO DATE
+5 if Y<0
GOTO EXIT
+6 if $DATA(DIRUT)
GOTO EXIT
+7 ;
+8 ; set visit ien variable
+9 SET ACKVIEN=+Y
+10 ;
+11 ; Attempt to Lock record if lock fails display error and re-prompt
+12 LOCK +^ACK(509850.6,ACKVIEN):2
IF '$TEST
Begin DoDot:1
+13 WRITE !!,"This record is locked by another process - Please try again later.",!!
End DoDot:1
GOTO DATE
+14 ;
+15 ; display summary details about the visit
+16 SET (DFN,ACKPAT)=+$$GET1^DIQ(509850.6,ACKVIEN_",",1,"I")
+17 DO DEM^VADPT
+18 SET ACKPATNM=VADM(1)
+19 SET ACKPATSS=$PIECE(VADM(2),U,2)
+20 ; clinic external
SET ACKCLNNM=$$GET1^DIQ(509850.6,ACKVIEN_",",2.6,"E")
+21 ; division external
SET ACKDIVNM=$$GET1^DIQ(509850.6,ACKVIEN_",",60,"E")
+22 ; date external
SET ACKDATE=$$GET1^DIQ(509850.6,ACKVIEN_",",.01,"E")
+23 SET ACKTM=$$GET1^DIQ(509850.6,ACKVIEN_",",55,"I")
SET ACKTIME=$$FMT^ACKQUTL6(ACKTM,0)
+24 ; pce visit ien
SET ACKPIEN=$$GET1^DIQ(509850.6,ACKVIEN_",",125,"I")
+25 ; pce flag
SET ACKP=$SELECT(ACKPIEN:".",1:"")
+26 WRITE !!?2," Patient: ",$EXTRACT(ACKPATNM,1,35)
+27 WRITE ?48," SSN: ",ACKPATSS
+28 WRITE !?2," Clinic: ",$EXTRACT(ACKCLNNM,1,35)
+29 WRITE ?48," Visit Date: ",$EXTRACT(ACKDATE,1,12)
+30 WRITE !?2,"Division: ",$EXTRACT(ACKDIVNM,1,35)
+31 WRITE ?48,"Appointment Time: ",ACKTIME_ACKP
+32 WRITE !
+33 ;
+34 ; determine whether the PCE Interface is ON
+35 SET ACKIFACE=0
+36 SET ACKPCES=$$GET1^DIQ(509850.8,"1,",2,"I")
+37 SET ACKDIV=$$GET1^DIQ(509850.6,ACKVIEN_",",60,"I")
+38 SET ACKVDT=$$GET1^DIQ(509850.6,ACKVIEN_",",.01,"I")
+39 SET ACKPCED=$$GET1^DIQ(509850.83,ACKDIV_",1,",.03,"I")
+40 SET ACKPCEDT=$$GET1^DIQ(509850.83,ACKDIV_",1,",.08,"I")
+41 ; if Site switch is ON and Division switch is ON and Visit Date is
+42 ; after PCE Interface Start Date, then Interface is ON.
+43 IF ACKPCES=1
IF ACKPCED=1
IF ACKVDT'<ACKPCEDT
SET ACKIFACE=1
+44 ;
+45 ; if interface is not on, but visit has a PCE Visit IEN, then display warning
+46 IF ACKIFACE=0
IF ACKPIEN
DO WARNING
+47 ;
DELETE ; ask user to confirm the deletion
+1 SET DIR(0)="Y"
SET DIR("B")="NO"
+2 SET DIR("A")="Do you wish to DELETE this Visit from QUASAR"
+3 DO ^DIR
+4 ; timed out
IF $DATA(DTOUT)
GOTO EXIT
+5 ; user exited
IF $DATA(DUOUT)
GOTO EXIT
+6 IF Y?1"^"1.E
WRITE !,"Jumping not allowed.",!
GOTO DELETE
+7 ; user chose not to delete
IF Y=0
GOTO EXIT
+8 WRITE !
+9 ;
+10 ; if the interface is not on, or the visit does not exist in PCE
+11 ; then proceed with deletion from QUASAR
+12 IF (ACKIFACE=0)!('ACKPIEN)
GOTO DOIT
+13 ;
DELPCE ; call the function to delete the visit from PCE
+1 SET ACKOK=$$KILLPCE^ACKQPCE(ACKVIEN)
+2 ;
+3 ; if deletion succeeded then jump to deletion point
+4 IF ACKOK
GOTO DOIT
+5 ;
FAILED ; if deletion failed then display errors
+1 WRITE !!?2,"ERROR: The PCE Visit linked to this QUASAR Visit could not be deleted."
+2 WRITE !!?2,"If you choose to continue, the QUASAR visit will be deleted but the PCE Visit"
+3 WRITE !?2,"will remain. Corrective action to the PCE Visit will be required using the"
+4 WRITE !?2,"PCE System.",!
+5 ;
CONFIRM ; prompt whether to continue
+1 SET DIR(0)="Y"
SET DIR("B")="NO"
+2 SET DIR("A")="Do you wish to DELETE just the QUASAR Visit"
+3 DO ^DIR
+4 ; timed out
IF $DATA(DTOUT)
GOTO EXIT
+5 ; user exited
IF $DATA(DUOUT)
GOTO EXIT
+6 IF Y?1"^"1.E
WRITE !,"Jumping not allowed.",!
GOTO CONFIRM
+7 ; user chose to exit
IF Y=0
GOTO EXIT
+8 ;
DOIT ; ok - delete the visit from Quasar
+1 KILL ACKARR
+2 SET ACKARR(509850.6,ACKVIEN_",",.01)="@"
+3 DO FILE^DIE("","ACKARR","")
+4 WRITE !?10,"* * * Visit deleted from QUASAR. * * *",!
+5 ; now update the problem list for the patient
+6 DO PROBLIST^ACKQUTL3(ACKPAT,1)
+7 ;
+8 ; all done
EXIT ;
+1 ; unlock
+2 LOCK
+3 ;
+4 ; clean up all variables
+5 KILL DIC,Y,ACKVIEN,DFN,ACKPAT,ACKPATSS,VADM,ACKPATNM,ACKCLNNM,ACKDIVNM
+6 KILL ACKDATE,ACKTM,ACKTIME,DIR,ACKOK,ACKARR,ACKP
+7 QUIT
+8 ;
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.
+2 WRITE !?2,"WARNING - This QUASAR Visit is linked to a PCE Visit but the PCE Interface"
+3 WRITE !?2,"is not active. If you delete this visit, it will be deleted from QUASAR but"
+4 WRITE !?2,"the corresponding PCE Visit will remain. To delete the visit from PCE you"
+5 WRITE !?2,"must use the PCE package options.",!
+6 QUIT
+7 ;
