1 | ACKQASU3 ;HCIOFO/BH-New/Edit Visit Utilities ; 04/01/99
|
---|
2 | ;;3.0;QUASAR;**2**;Feb 11, 2000
|
---|
3 | ;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
|
---|
4 | ;
|
---|
5 | PCESEND(ACKVIEN) ; This function is called from within the New Visit
|
---|
6 | ; and Edit visit processing. It calls the send to PCE function.
|
---|
7 | ; The SEND to PCE function returns either true or false depending on
|
---|
8 | ; whether the visit has been sent successfully. It the SEND function
|
---|
9 | ; returns true this function quits returning a true value. If the
|
---|
10 | ; SEND function returns false the error is displayed (contained in the
|
---|
11 | ; error multiple of the A&SP visit file). The user is then offered
|
---|
12 | ; the option to either quit processing this visit and leave it with an
|
---|
13 | ; error or to return back into the visit entry function - thus
|
---|
14 | ; enabling the user to edit the erroreous field.
|
---|
15 | ;
|
---|
16 | ; Input : ACKVIEN=IEN of visit to be processed
|
---|
17 | ; Output : '1' or '0'
|
---|
18 | ;
|
---|
19 | N X,Y,DA,D,D0,DA,DI,DIC,DIE,DIFLD,DK,DL,DR
|
---|
20 | I $$SENDPCE^ACKQPCE(ACKVIEN) Q 1
|
---|
21 | ; If here transmission was unsucceful - Error text will in field 6.5
|
---|
22 | ;
|
---|
23 | ; Display transmission Error
|
---|
24 | D ERORDISP(ACKVIEN)
|
---|
25 | ;
|
---|
26 | ; Prompt user if they wish to re-edit the visit
|
---|
27 | ;
|
---|
28 | TEST S DIR("A")=" Do you wish to Re-edit this Visit "
|
---|
29 | S DIR("B")="Y"
|
---|
30 | S DIR("?")=" Do you wish to Re-edit this visit or Quit ? Enter (Y) or (N)."
|
---|
31 | S DIR(0)="Y"
|
---|
32 | D ^DIR K DIR
|
---|
33 | I $D(DIRUT) Q 1
|
---|
34 | I X="Y"!(X="y") Q 0
|
---|
35 | I X="N"!(X="n") Q 1
|
---|
36 | ;
|
---|
37 | Q
|
---|
38 | ;
|
---|
39 | ERORDISP(ACKVIEN) ; Display text that defines the reason for the
|
---|
40 | ; transmission failiure to PCE.
|
---|
41 | ; Passed in Visit IEN, Displays error multiple (6.5) of the associated
|
---|
42 | ; visit.
|
---|
43 | N ACKNUM,ACKK1,ACKTGT,ACKFLD,ACKVAL,ACKERR
|
---|
44 | ;
|
---|
45 | W @IOF
|
---|
46 | I $O(^ACK(509850.6,ACKVIEN,6.5,0))="" D HEADING W !!!," No Error information returned for display.",!! Q
|
---|
47 | ;
|
---|
48 | S ACKK1=0 D HEADING
|
---|
49 | F S ACKK1=$O(^ACK(509850.6,ACKVIEN,6.5,ACKK1)) Q:'+ACKK1 D
|
---|
50 | . D GETS^DIQ(509850.65,ACKK1_","_ACKVIEN_",",".02;.04;1","I","ACKTGT")
|
---|
51 | . S ACKFLD=$G(ACKTGT(509850.65,ACKK1_","_ACKVIEN_",",.02,"I"))
|
---|
52 | . S ACKVAL=$G(ACKTGT(509850.65,ACKK1_","_ACKVIEN_",",.04,"I"))
|
---|
53 | . S ACKERR=$G(ACKTGT(509850.65,ACKK1_","_ACKVIEN_",",1,"I"))
|
---|
54 | . S ACKNUM=$E("Error #"_ACKK1,1,10),ACKFLD=$E("Field: "_ACKFLD,1,28)
|
---|
55 | . S ACKVAL=$E("Value: "_ACKVAL,1,21),ACKERR=$E("Message: "_ACKERR,1,72)
|
---|
56 | . W !!,?2,ACKNUM,?20,ACKFLD,?50,ACKVAL,!
|
---|
57 | . W ?2,ACKERR
|
---|
58 | ;
|
---|
59 | W !!
|
---|
60 | Q
|
---|
61 | ;
|
---|
62 | HEADING ;
|
---|
63 | W "There has been an Error during the Transmission of this QUASAR visit.",!
|
---|
64 | W "The PCE system has return the following Errors for this visit."
|
---|
65 | Q
|
---|
66 | ;
|
---|
67 | DATACHK(ACKVIEN) ; PCE Data integrity check.
|
---|
68 | ; Only called if Quasar visit has a value within the PCE VISIT IEN
|
---|
69 | ; field. This routine check the Clinic,Patient,Appointment time and
|
---|
70 | ; Visit date values on the quasar file and compares them to the same
|
---|
71 | ; fields on the associated PCE record. If the values are all the same
|
---|
72 | ; the routine Quits. If the Clinic,Patient or Visit Date are different
|
---|
73 | ; then a message is displayed to the user detailing which field(s) are
|
---|
74 | ; different and then deletes the PCE VISIT IEN.If just the Appointment
|
---|
75 | ; Time is different a message is displayed the user then has the choice
|
---|
76 | ; to either overwrite the Quasar time with the PCE time or to leave the
|
---|
77 | ; Quasar time as it is and Quasar will delete the PCE VISIT IEN.
|
---|
78 | N ACKARR,ACKTEST,ACKSTAT,ACKOUT
|
---|
79 | S ACKTEST=$$PCECHKV^ACKQUTL3(ACKVIEN)
|
---|
80 | S ACKSTAT=$P(ACKTEST,"^",1)
|
---|
81 | ;
|
---|
82 | I ACKSTAT=2 Q 1 ; Everything is okay
|
---|
83 | ;
|
---|
84 | I ACKSTAT=0 D Q ACKOUT ; Clinic, Patient or Visit Date different
|
---|
85 | . W !!,"The following fields within the PCE Visit entry linked to this Quasar visit no"
|
---|
86 | . W !,"longer match.",!
|
---|
87 | . I '$P(ACKTEST,U,2) W !," CLINIC LOCATION"
|
---|
88 | . I '$P(ACKTEST,U,3) W !," PATIENT"
|
---|
89 | . I '$P(ACKTEST,U,4) W !," VISIT DATE"
|
---|
90 | . W !!,"Due to this mismatch the link between this Quasar visit and the PCE visit will"
|
---|
91 | . W !,"be broken.",!
|
---|
92 | . S ACKARR(509850.6,ACKVIEN_",",125)="" D FILE^DIE("","ACKARR")
|
---|
93 | . W !,"Enter <RETURN> to continue processing this visit or '^' to Quit."
|
---|
94 | . S DIR(0)="E" D ^DIR I $D(DUOUT)!($D(DTOUT)) S ACKOUT=0 Q
|
---|
95 | . S ACKOUT=1 Q
|
---|
96 | ;
|
---|
97 | I ACKSTAT=1 D Q ACKOUT
|
---|
98 | . W !!,"The Appointment Time of "_$$FMT^ACKQUTL6(ACKTEST)_" within the PCE Visit no longer matches the"
|
---|
99 | . W !,"Appointment Time of "_$$FMT^ACKQUTL6($$GET1^DIQ(509850.6,ACKVIEN_",",55,"I"))_" within the linked Quasar visit.",!
|
---|
100 | . K DIR S DIR(0)="Y",DIR("B")="YES"
|
---|
101 | . S DIR("A")="Update this Quasar Visit with PCE Appointment Time "
|
---|
102 | . S DIR("?")="Enter YES to Update Quasar with the linked PCE visits Appointment Time, 'NO' to break the link between the Quasar visit and the PCE Visit or '^' to Quit with no action."
|
---|
103 | . D ^DIR K DIR I $D(DTOUT) S X=U
|
---|
104 | . I X="^" S ACKOUT=0 Q
|
---|
105 | . I $E(X)="N" S ACKARR(509850.6,ACKVIEN_",",125)="" D FILE^DIE("","ACKARR") S ACKOUT=1 Q
|
---|
106 | . I $E(X)="Y" S ACKARR(509850.6,ACKVIEN_",",55)=$P(ACKTEST,U,2) D FILE^DIE("","ACKARR") S ACKOUT=1 Q
|
---|
107 | Q
|
---|
108 | ;
|
---|