| 1 | ACKQAS4 ;HCIOFO/AG - Delete a Quasar 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 | ;
|
|---|
| 5 | N DIC,X,Y,ACKVIEN,DFN,ACKPAT,VADM,ACKPATNM,ACKPATSS,ACKCLNNM,ACKDIVNM
|
|---|
| 6 | N ACKDATE,ACKTM,ACKTIME,ACKPIEN,ACKP,ACKIFACE,ACKPCES,ACKDIV,ACKVDT
|
|---|
| 7 | N ACKPCED,ACKPCEDT,DIR,ACKOK,ACKARR
|
|---|
| 8 | ;
|
|---|
| 9 | OPTN ; Introduce option.
|
|---|
| 10 | W @IOF
|
|---|
| 11 | W !!,"This option is used to DELETE an existing A&SP Clinic Visit.",!!
|
|---|
| 12 | ;
|
|---|
| 13 | DATE ; Enter date
|
|---|
| 14 | W !
|
|---|
| 15 | S DIC("W")="W $$DISPLAY^ACKQUTL3(Y,$X)"
|
|---|
| 16 | S DIC=509850.6,DIC(0)="AEQZ" D ^DIC
|
|---|
| 17 | I X?1"^"1.E W !,"Jumping not allowed.",! G DATE
|
|---|
| 18 | G:Y<0 EXIT
|
|---|
| 19 | G:$D(DIRUT) EXIT
|
|---|
| 20 | ;
|
|---|
| 21 | ; set visit ien variable
|
|---|
| 22 | S ACKVIEN=+Y
|
|---|
| 23 | ;
|
|---|
| 24 | ; Attempt to Lock record if lock fails display error and re-prompt
|
|---|
| 25 | L +^ACK(509850.6,ACKVIEN):2 I '$T D G DATE
|
|---|
| 26 | . W !!,"This record is locked by another process - Please try again later.",!!
|
|---|
| 27 | ;
|
|---|
| 28 | ; display summary details about the visit
|
|---|
| 29 | S (DFN,ACKPAT)=+$$GET1^DIQ(509850.6,ACKVIEN_",",1,"I")
|
|---|
| 30 | D DEM^VADPT
|
|---|
| 31 | S ACKPATNM=VADM(1)
|
|---|
| 32 | S ACKPATSS=$P(VADM(2),U,2)
|
|---|
| 33 | S ACKCLNNM=$$GET1^DIQ(509850.6,ACKVIEN_",",2.6,"E") ; clinic external
|
|---|
| 34 | S ACKDIVNM=$$GET1^DIQ(509850.6,ACKVIEN_",",60,"E") ; division external
|
|---|
| 35 | S ACKDATE=$$GET1^DIQ(509850.6,ACKVIEN_",",.01,"E") ; date external
|
|---|
| 36 | S ACKTM=$$GET1^DIQ(509850.6,ACKVIEN_",",55,"I"),ACKTIME=$$FMT^ACKQUTL6(ACKTM,0)
|
|---|
| 37 | S ACKPIEN=$$GET1^DIQ(509850.6,ACKVIEN_",",125,"I") ; pce visit ien
|
|---|
| 38 | S ACKP=$S(ACKPIEN:".",1:"") ; pce flag
|
|---|
| 39 | W !!?2," Patient: ",$E(ACKPATNM,1,35)
|
|---|
| 40 | W ?48," SSN: ",ACKPATSS
|
|---|
| 41 | W !?2," Clinic: ",$E(ACKCLNNM,1,35)
|
|---|
| 42 | W ?48," Visit Date: ",$E(ACKDATE,1,12)
|
|---|
| 43 | W !?2,"Division: ",$E(ACKDIVNM,1,35)
|
|---|
| 44 | W ?48,"Appointment Time: ",ACKTIME_ACKP
|
|---|
| 45 | W !
|
|---|
| 46 | ;
|
|---|
| 47 | ; determine whether the PCE Interface is ON
|
|---|
| 48 | S ACKIFACE=0
|
|---|
| 49 | S ACKPCES=$$GET1^DIQ(509850.8,"1,",2,"I")
|
|---|
| 50 | S ACKDIV=$$GET1^DIQ(509850.6,ACKVIEN_",",60,"I")
|
|---|
| 51 | S ACKVDT=$$GET1^DIQ(509850.6,ACKVIEN_",",.01,"I")
|
|---|
| 52 | S ACKPCED=$$GET1^DIQ(509850.83,ACKDIV_",1,",.03,"I")
|
|---|
| 53 | S ACKPCEDT=$$GET1^DIQ(509850.83,ACKDIV_",1,",.08,"I")
|
|---|
| 54 | ; if Site switch is ON and Division switch is ON and Visit Date is
|
|---|
| 55 | ; after PCE Interface Start Date, then Interface is ON.
|
|---|
| 56 | I ACKPCES=1,ACKPCED=1,ACKVDT'<ACKPCEDT S ACKIFACE=1
|
|---|
| 57 | ;
|
|---|
| 58 | ; if interface is not on, but visit has a PCE Visit IEN, then display warning
|
|---|
| 59 | I ACKIFACE=0,ACKPIEN D WARNING
|
|---|
| 60 | ;
|
|---|
| 61 | DELETE ; ask user to confirm the deletion
|
|---|
| 62 | S DIR(0)="Y",DIR("B")="NO"
|
|---|
| 63 | S DIR("A")="Do you wish to DELETE this Visit from QUASAR"
|
|---|
| 64 | D ^DIR
|
|---|
| 65 | I $D(DTOUT) G EXIT ; timed out
|
|---|
| 66 | I $D(DUOUT) G EXIT ; user exited
|
|---|
| 67 | I Y?1"^"1.E W !,"Jumping not allowed.",! G DELETE
|
|---|
| 68 | I Y=0 G EXIT ; user chose not to delete
|
|---|
| 69 | W !
|
|---|
| 70 | ;
|
|---|
| 71 | ; if the interface is not on, or the visit does not exist in PCE
|
|---|
| 72 | ; then proceed with deletion from QUASAR
|
|---|
| 73 | I (ACKIFACE=0)!('ACKPIEN) G DOIT
|
|---|
| 74 | ;
|
|---|
| 75 | DELPCE ; call the function to delete the visit from PCE
|
|---|
| 76 | S ACKOK=$$KILLPCE^ACKQPCE(ACKVIEN)
|
|---|
| 77 | ;
|
|---|
| 78 | ; if deletion succeeded then jump to deletion point
|
|---|
| 79 | I ACKOK G DOIT
|
|---|
| 80 | ;
|
|---|
| 81 | FAILED ; if deletion failed then display errors
|
|---|
| 82 | W !!?2,"ERROR: The PCE Visit linked to this QUASAR Visit could not be deleted."
|
|---|
| 83 | W !!?2,"If you choose to continue, the QUASAR visit will be deleted but the PCE Visit"
|
|---|
| 84 | W !?2,"will remain. Corrective action to the PCE Visit will be required using the"
|
|---|
| 85 | W !?2,"PCE System.",!
|
|---|
| 86 | ;
|
|---|
| 87 | CONFIRM ; prompt whether to continue
|
|---|
| 88 | S DIR(0)="Y",DIR("B")="NO"
|
|---|
| 89 | S DIR("A")="Do you wish to DELETE just the QUASAR Visit"
|
|---|
| 90 | D ^DIR
|
|---|
| 91 | I $D(DTOUT) G EXIT ; timed out
|
|---|
| 92 | I $D(DUOUT) G EXIT ; user exited
|
|---|
| 93 | I Y?1"^"1.E W !,"Jumping not allowed.",! G CONFIRM
|
|---|
| 94 | I Y=0 G EXIT ; user chose to exit
|
|---|
| 95 | ;
|
|---|
| 96 | DOIT ; ok - delete the visit from Quasar
|
|---|
| 97 | K ACKARR
|
|---|
| 98 | S ACKARR(509850.6,ACKVIEN_",",.01)="@"
|
|---|
| 99 | D FILE^DIE("","ACKARR","")
|
|---|
| 100 | W !?10,"* * * Visit deleted from QUASAR. * * *",!
|
|---|
| 101 | ; now update the problem list for the patient
|
|---|
| 102 | D PROBLIST^ACKQUTL3(ACKPAT,1)
|
|---|
| 103 | ;
|
|---|
| 104 | ; all done
|
|---|
| 105 | EXIT ;
|
|---|
| 106 | ; unlock
|
|---|
| 107 | L
|
|---|
| 108 | ;
|
|---|
| 109 | ; clean up all variables
|
|---|
| 110 | K DIC,Y,ACKVIEN,DFN,ACKPAT,ACKPATSS,VADM,ACKPATNM,ACKCLNNM,ACKDIVNM
|
|---|
| 111 | K ACKDATE,ACKTM,ACKTIME,DIR,ACKOK,ACKARR,ACKP
|
|---|
| 112 | Q
|
|---|
| 113 | ;
|
|---|
| 114 | WARNING ; display a warning to the user that the interface is not on so this
|
|---|
| 115 | ; deletion will not be replicated in the PCE database.
|
|---|
| 116 | W !?2,"WARNING - This QUASAR Visit is linked to a PCE Visit but the PCE Interface"
|
|---|
| 117 | W !?2,"is not active. If you delete this visit, it will be deleted from QUASAR but"
|
|---|
| 118 | W !?2,"the corresponding PCE Visit will remain. To delete the visit from PCE you"
|
|---|
| 119 | W !?2,"must use the PCE package options.",!
|
|---|
| 120 | Q
|
|---|
| 121 | ;
|
|---|
