source: WorldVistAEHR/trunk/r/QUASAR-ACKQ/ACKQAS4.m@ 701

Last change on this file since 701 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.3 KB
Line 
1ACKQAS4 ;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 ;
9OPTN ; Introduce option.
10 W @IOF
11 W !!,"This option is used to DELETE an existing A&SP Clinic Visit.",!!
12 ;
13DATE ; 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 ;
61DELETE ; 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 ;
75DELPCE ; 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 ;
81FAILED ; 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 ;
87CONFIRM ; 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 ;
96DOIT ; 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
105EXIT ;
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 ;
114WARNING ; 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 ;
Note: See TracBrowser for help on using the repository browser.