ACKQASU3 ;HCIOFO/BH-New/Edit Visit Utilities ; 04/01/99
;;3.0;QUASAR;**2**;Feb 11, 2000
;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
;
PCESEND(ACKVIEN) ; This function is called from within the New Visit
; and Edit visit processing. It calls the send to PCE function.
; The SEND to PCE function returns either true or false depending on
; whether the visit has been sent successfully. It the SEND function
; returns true this function quits returning a true value. If the
; SEND function returns false the error is displayed (contained in the
; error multiple of the A&SP visit file). The user is then offered
; the option to either quit processing this visit and leave it with an
; error or to return back into the visit entry function - thus
; enabling the user to edit the erroreous field.
;
; Input : ACKVIEN=IEN of visit to be processed
; Output : '1' or '0'
;
N X,Y,DA,D,D0,DA,DI,DIC,DIE,DIFLD,DK,DL,DR
I $$SENDPCE^ACKQPCE(ACKVIEN) Q 1
; If here transmission was unsucceful - Error text will in field 6.5
;
; Display transmission Error
D ERORDISP(ACKVIEN)
;
; Prompt user if they wish to re-edit the visit
;
TEST S DIR("A")=" Do you wish to Re-edit this Visit "
S DIR("B")="Y"
S DIR("?")=" Do you wish to Re-edit this visit or Quit ? Enter (Y) or (N)."
S DIR(0)="Y"
D ^DIR K DIR
I $D(DIRUT) Q 1
I X="Y"!(X="y") Q 0
I X="N"!(X="n") Q 1
;
Q
;
ERORDISP(ACKVIEN) ; Display text that defines the reason for the
; transmission failiure to PCE.
; Passed in Visit IEN, Displays error multiple (6.5) of the associated
; visit.
N ACKNUM,ACKK1,ACKTGT,ACKFLD,ACKVAL,ACKERR
;
W @IOF
I $O(^ACK(509850.6,ACKVIEN,6.5,0))="" D HEADING W !!!," No Error information returned for display.",!! Q
;
S ACKK1=0 D HEADING
F S ACKK1=$O(^ACK(509850.6,ACKVIEN,6.5,ACKK1)) Q:'+ACKK1 D
. D GETS^DIQ(509850.65,ACKK1_","_ACKVIEN_",",".02;.04;1","I","ACKTGT")
. S ACKFLD=$G(ACKTGT(509850.65,ACKK1_","_ACKVIEN_",",.02,"I"))
. S ACKVAL=$G(ACKTGT(509850.65,ACKK1_","_ACKVIEN_",",.04,"I"))
. S ACKERR=$G(ACKTGT(509850.65,ACKK1_","_ACKVIEN_",",1,"I"))
. S ACKNUM=$E("Error #"_ACKK1,1,10),ACKFLD=$E("Field: "_ACKFLD,1,28)
. S ACKVAL=$E("Value: "_ACKVAL,1,21),ACKERR=$E("Message: "_ACKERR,1,72)
. W !!,?2,ACKNUM,?20,ACKFLD,?50,ACKVAL,!
. W ?2,ACKERR
;
W !!
Q
;
HEADING ;
W "There has been an Error during the Transmission of this QUASAR visit.",!
W "The PCE system has return the following Errors for this visit."
Q
;
DATACHK(ACKVIEN) ; PCE Data integrity check.
; Only called if Quasar visit has a value within the PCE VISIT IEN
; field. This routine check the Clinic,Patient,Appointment time and
; Visit date values on the quasar file and compares them to the same
; fields on the associated PCE record. If the values are all the same
; the routine Quits. If the Clinic,Patient or Visit Date are different
; then a message is displayed to the user detailing which field(s) are
; different and then deletes the PCE VISIT IEN.If just the Appointment
; Time is different a message is displayed the user then has the choice
; to either overwrite the Quasar time with the PCE time or to leave the
; Quasar time as it is and Quasar will delete the PCE VISIT IEN.
N ACKARR,ACKTEST,ACKSTAT,ACKOUT
S ACKTEST=$$PCECHKV^ACKQUTL3(ACKVIEN)
S ACKSTAT=$P(ACKTEST,"^",1)
;
I ACKSTAT=2 Q 1 ; Everything is okay
;
I ACKSTAT=0 D Q ACKOUT ; Clinic, Patient or Visit Date different
. W !!,"The following fields within the PCE Visit entry linked to this Quasar visit no"
. W !,"longer match.",!
. I '$P(ACKTEST,U,2) W !," CLINIC LOCATION"
. I '$P(ACKTEST,U,3) W !," PATIENT"
. I '$P(ACKTEST,U,4) W !," VISIT DATE"
. W !!,"Due to this mismatch the link between this Quasar visit and the PCE visit will"
. W !,"be broken.",!
. S ACKARR(509850.6,ACKVIEN_",",125)="" D FILE^DIE("","ACKARR")
. W !,"Enter <RETURN> to continue processing this visit or '^' to Quit."
. S DIR(0)="E" D ^DIR I $D(DUOUT)!($D(DTOUT)) S ACKOUT=0 Q
. S ACKOUT=1 Q
;
I ACKSTAT=1 D Q ACKOUT
. W !!,"The Appointment Time of "_$$FMT^ACKQUTL6(ACKTEST)_" within the PCE Visit no longer matches the"
. W !,"Appointment Time of "_$$FMT^ACKQUTL6($$GET1^DIQ(509850.6,ACKVIEN_",",55,"I"))_" within the linked Quasar visit.",!
. K DIR S DIR(0)="Y",DIR("B")="YES"
. S DIR("A")="Update this Quasar Visit with PCE Appointment Time "
. 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."
. D ^DIR K DIR I $D(DTOUT) S X=U
. I X="^" S ACKOUT=0 Q
. I $E(X)="N" S ACKARR(509850.6,ACKVIEN_",",125)="" D FILE^DIE("","ACKARR") S ACKOUT=1 Q
. I $E(X)="Y" S ACKARR(509850.6,ACKVIEN_",",55)=$P(ACKTEST,U,2) D FILE^DIE("","ACKARR") S ACKOUT=1 Q
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HACKQASU3 4965 printed Dec 13, 2024@02:31:48 Page 2
ACKQASU3 ;HCIOFO/BH-New/Edit Visit Utilities ; 04/01/99
+1 ;;3.0;QUASAR;**2**;Feb 11, 2000
+2 ;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
+3 ;
PCESEND(ACKVIEN) ; This function is called from within the New Visit
+1 ; and Edit visit processing. It calls the send to PCE function.
+2 ; The SEND to PCE function returns either true or false depending on
+3 ; whether the visit has been sent successfully. It the SEND function
+4 ; returns true this function quits returning a true value. If the
+5 ; SEND function returns false the error is displayed (contained in the
+6 ; error multiple of the A&SP visit file). The user is then offered
+7 ; the option to either quit processing this visit and leave it with an
+8 ; error or to return back into the visit entry function - thus
+9 ; enabling the user to edit the erroreous field.
+10 ;
+11 ; Input : ACKVIEN=IEN of visit to be processed
+12 ; Output : '1' or '0'
+13 ;
+14 NEW X,Y,DA,D,D0,DA,DI,DIC,DIE,DIFLD,DK,DL,DR
+15 IF $$SENDPCE^ACKQPCE(ACKVIEN)
QUIT 1
+16 ; If here transmission was unsucceful - Error text will in field 6.5
+17 ;
+18 ; Display transmission Error
+19 DO ERORDISP(ACKVIEN)
+20 ;
+21 ; Prompt user if they wish to re-edit the visit
+22 ;
TEST SET DIR("A")=" Do you wish to Re-edit this Visit "
+1 SET DIR("B")="Y"
+2 SET DIR("?")=" Do you wish to Re-edit this visit or Quit ? Enter (Y) or (N)."
+3 SET DIR(0)="Y"
+4 DO ^DIR
KILL DIR
+5 IF $DATA(DIRUT)
QUIT 1
+6 IF X="Y"!(X="y")
QUIT 0
+7 IF X="N"!(X="n")
QUIT 1
+8 ;
+9 QUIT
+10 ;
ERORDISP(ACKVIEN) ; Display text that defines the reason for the
+1 ; transmission failiure to PCE.
+2 ; Passed in Visit IEN, Displays error multiple (6.5) of the associated
+3 ; visit.
+4 NEW ACKNUM,ACKK1,ACKTGT,ACKFLD,ACKVAL,ACKERR
+5 ;
+6 WRITE @IOF
+7 IF $ORDER(^ACK(509850.6,ACKVIEN,6.5,0))=""
DO HEADING
WRITE !!!," No Error information returned for display.",!!
QUIT
+8 ;
+9 SET ACKK1=0
DO HEADING
+10 FOR
SET ACKK1=$ORDER(^ACK(509850.6,ACKVIEN,6.5,ACKK1))
if '+ACKK1
QUIT
Begin DoDot:1
+11 DO GETS^DIQ(509850.65,ACKK1_","_ACKVIEN_",",".02;.04;1","I","ACKTGT")
+12 SET ACKFLD=$GET(ACKTGT(509850.65,ACKK1_","_ACKVIEN_",",.02,"I"))
+13 SET ACKVAL=$GET(ACKTGT(509850.65,ACKK1_","_ACKVIEN_",",.04,"I"))
+14 SET ACKERR=$GET(ACKTGT(509850.65,ACKK1_","_ACKVIEN_",",1,"I"))
+15 SET ACKNUM=$EXTRACT("Error #"_ACKK1,1,10)
SET ACKFLD=$EXTRACT("Field: "_ACKFLD,1,28)
+16 SET ACKVAL=$EXTRACT("Value: "_ACKVAL,1,21)
SET ACKERR=$EXTRACT("Message: "_ACKERR,1,72)
+17 WRITE !!,?2,ACKNUM,?20,ACKFLD,?50,ACKVAL,!
+18 WRITE ?2,ACKERR
End DoDot:1
+19 ;
+20 WRITE !!
+21 QUIT
+22 ;
HEADING ;
+1 WRITE "There has been an Error during the Transmission of this QUASAR visit.",!
+2 WRITE "The PCE system has return the following Errors for this visit."
+3 QUIT
+4 ;
DATACHK(ACKVIEN) ; PCE Data integrity check.
+1 ; Only called if Quasar visit has a value within the PCE VISIT IEN
+2 ; field. This routine check the Clinic,Patient,Appointment time and
+3 ; Visit date values on the quasar file and compares them to the same
+4 ; fields on the associated PCE record. If the values are all the same
+5 ; the routine Quits. If the Clinic,Patient or Visit Date are different
+6 ; then a message is displayed to the user detailing which field(s) are
+7 ; different and then deletes the PCE VISIT IEN.If just the Appointment
+8 ; Time is different a message is displayed the user then has the choice
+9 ; to either overwrite the Quasar time with the PCE time or to leave the
+10 ; Quasar time as it is and Quasar will delete the PCE VISIT IEN.
+11 NEW ACKARR,ACKTEST,ACKSTAT,ACKOUT
+12 SET ACKTEST=$$PCECHKV^ACKQUTL3(ACKVIEN)
+13 SET ACKSTAT=$PIECE(ACKTEST,"^",1)
+14 ;
+15 ; Everything is okay
IF ACKSTAT=2
QUIT 1
+16 ;
+17 ; Clinic, Patient or Visit Date different
IF ACKSTAT=0
Begin DoDot:1
+18 WRITE !!,"The following fields within the PCE Visit entry linked to this Quasar visit no"
+19 WRITE !,"longer match.",!
+20 IF '$PIECE(ACKTEST,U,2)
WRITE !," CLINIC LOCATION"
+21 IF '$PIECE(ACKTEST,U,3)
WRITE !," PATIENT"
+22 IF '$PIECE(ACKTEST,U,4)
WRITE !," VISIT DATE"
+23 WRITE !!,"Due to this mismatch the link between this Quasar visit and the PCE visit will"
+24 WRITE !,"be broken.",!
+25 SET ACKARR(509850.6,ACKVIEN_",",125)=""
DO FILE^DIE("","ACKARR")
+26 WRITE !,"Enter <RETURN> to continue processing this visit or '^' to Quit."
+27 SET DIR(0)="E"
DO ^DIR
IF $DATA(DUOUT)!($DATA(DTOUT))
SET ACKOUT=0
QUIT
+28 SET ACKOUT=1
QUIT
End DoDot:1
QUIT ACKOUT
+29 ;
+30 IF ACKSTAT=1
Begin DoDot:1
+31 WRITE !!,"The Appointment Time of "_$$FMT^ACKQUTL6(ACKTEST)_" within the PCE Visit no longer matches the"
+32 WRITE !,"Appointment Time of "_$$FMT^ACKQUTL6($$GET1^DIQ(509850.6,ACKVIEN_",",55,"I"))_" within the linked Quasar visit.",!
+33 KILL DIR
SET DIR(0)="Y"
SET DIR("B")="YES"
+34 SET DIR("A")="Update this Quasar Visit with PCE Appointment Time "
+35 SET 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."
+36 DO ^DIR
KILL DIR
IF $DATA(DTOUT)
SET X=U
+37 IF X="^"
SET ACKOUT=0
QUIT
+38 IF $EXTRACT(X)="N"
SET ACKARR(509850.6,ACKVIEN_",",125)=""
DO FILE^DIE("","ACKARR")
SET ACKOUT=1
QUIT
+39 IF $EXTRACT(X)="Y"
SET ACKARR(509850.6,ACKVIEN_",",55)=$PIECE(ACKTEST,U,2)
DO FILE^DIE("","ACKARR")
SET ACKOUT=1
QUIT
End DoDot:1
QUIT ACKOUT
+40 QUIT
+41 ;
