ACKQASU7 ;HCIOFO/AG - New/Edit Visit Utilities ; 04/01/99
;;3.0;QUASAR;;Feb 11, 2000
;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
;
;
SHOWPCE(ACKGBL) ; display errors from COPYPCE stored in @ACKGBL
; this routine displays on the screen any errors found in the global
; referenced by ACKGBL that were created by COPYPCE^ACKQASU4.
; format for global is @ACKGBL=number or errors
; @ACKGBL@(n)=field^int^ext^message
; returns:- 0 - continue, 1 - user typed '^' to exit
N ACKERR,ACKECT,ACKLN,ACKTMP,ACKFLD,ACKINT,ACKEXT,ACKMSG,ACKTXT,ACKLF
N DIRUT,ACKTAB,ACKLEN
;
; get number of errors, initialise line counter
S ACKERR=@ACKGBL,ACKLN=0
;
; show header
W !!?2,"ERROR - The following errors occurred while copying the PCE Visit"
W !?2,"data into QUASAR. The fields in error are displayed below with the"
W !?2,"reason they were rejected.",!
S ACKLN=6
;
; display the errors
F ACKECT=1:1:ACKERR D Q:$D(DIRUT)
. S ACKTMP=@ACKGBL@(ACKECT)
. S ACKFLD=$P(ACKTMP,U,1),ACKINT=$P(ACKTMP,U,2),ACKEXT=$P(ACKTMP,U,3)
. S ACKDTA=$S(ACKEXT="":ACKINT,1:ACKEXT)
. S ACKTAB=$S($L(ACKDTA)>19:35,1:13+$L(ACKDTA)+2+5\5*5),ACKLEN=80-ACKTAB
. W !?2,ACKFLD_":",?13,$E(ACKDTA,1,20)
. S ACKMSG=$P(ACKTMP,U,4),ACKLF=0
. F Q:ACKMSG="" D Q:$D(DIRUT)
. . S ACKTXT=$E(ACKMSG,1,ACKLEN) D ; reset TXT (word wrap)
. . . I ($E(ACKTXT,ACKLEN)?1P)!($E(ACKMSG,ACKLEN+1)?1P) Q
. . . S ACKI=0 I $L(ACKTXT)=ACKLEN F ACKI=ACKLEN:-1:0 Q:$E(ACKTXT,ACKI)?1P
. . . I ACKI S ACKTXT=$E(ACKTXT,1,ACKI) Q
. . W:ACKLF ! W ?ACKTAB,ACKTXT S ACKLF=1
. . S ACKLN=ACKLN+1 D PAUSE Q:$D(DIRUT)
. . S ACKMSG=$P(ACKMSG,ACKTXT,2,999)
. . F Q:$E(ACKMSG)'=" " S ACKMSG=$E(ACKMSG,2,999)
;
; all done
I '$D(DIRUT) S ACKLN=0 D PAUSE
; return 1 if user chose to quit, 0 if they didn't
Q $D(DIRUT)
;
PAUSE ;
Q:ACKLN#15'=0
W !!
K DIR S DIR(0)="E" D ^DIR K DIR ; Return to Continue '^' to Exit
W !
Q
;
ACKAPMNT(ACKVD,ACKVTME,ACKCLIN,ACKPAT) ;
;
; //First checks to see if Patient is an Inpatient if they are then
; //dont display this message.
; Checks to see if the visit entered corresponds to a Visit Within
; Appointment Management. If does'nt a warning is displayed - the
; can continue or quit. This is to remind/encorage users to enter
; visits first through Appointment Management then pick them up
; in Quasar.
;
; N VAIN D INP^VADPT I $P(VAIN(4),U,2)'="" Q 1
;
N ACKK1,ACKT,ACKOKAY
I ACKVTME="" G MESSAG
;
S DFN=ACKPAT,VASD("C",ACKCLIN)="",VASD("T")=ACKVD,VASD("F")=ACKVD
S VASD("W")="129"
K ^UTILITY("VASD",$J) D SDA^VADPT ; Call appointment utility
I '$D(^UTILITY("VASD",$J)) G MESSAG ; Nothing returned=No appointment
;
S ACKK1="",ACKOKAY=0
F S ACKK1=$O(^UTILITY("VASD",$J,ACKK1)) Q:ACKK1=""!(ACKOKAY) D
. S ACKT=$P(^UTILITY("VASD",$J,ACKK1,"I"),U,1)
. S ACKT=$P(ACKT,".",2)
. I ACKT=ACKVTME S ACKOKAY=1
K ^UTILITY("VASD",$J)
;
I ACKOKAY Q 1
;
MESSAG ;
W !!!,"WARNING -",!
W !,"You are Creating a Visit that does not exist within Appointment Management."
W !,"This Visit will not be displayed within Appointment Management.",!
;
N DIR,DUOUT,DTOUT,DIRUT
OK2 S DIR(0)="Y",DIR("B")="NO",DIR("A")="Do you want to Continue "
S DIR("?")="Answer YES to continue with New Visit Entry or NO to quit."
D ^DIR
I Y?1"^"1.E W !,"Jumping not allowed.",! G OK2
S:$D(DIRUT) Y=0
S:$D(DTOUT) Y=0
Q Y
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HACKQASU7 3471 printed Apr 09, 2024@21:34:21 Page 2
ACKQASU7 ;HCIOFO/AG - New/Edit Visit Utilities ; 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 ;
SHOWPCE(ACKGBL) ; display errors from COPYPCE stored in @ACKGBL
+1 ; this routine displays on the screen any errors found in the global
+2 ; referenced by ACKGBL that were created by COPYPCE^ACKQASU4.
+3 ; format for global is @ACKGBL=number or errors
+4 ; @ACKGBL@(n)=field^int^ext^message
+5 ; returns:- 0 - continue, 1 - user typed '^' to exit
+6 NEW ACKERR,ACKECT,ACKLN,ACKTMP,ACKFLD,ACKINT,ACKEXT,ACKMSG,ACKTXT,ACKLF
+7 NEW DIRUT,ACKTAB,ACKLEN
+8 ;
+9 ; get number of errors, initialise line counter
+10 SET ACKERR=@ACKGBL
SET ACKLN=0
+11 ;
+12 ; show header
+13 WRITE !!?2,"ERROR - The following errors occurred while copying the PCE Visit"
+14 WRITE !?2,"data into QUASAR. The fields in error are displayed below with the"
+15 WRITE !?2,"reason they were rejected.",!
+16 SET ACKLN=6
+17 ;
+18 ; display the errors
+19 FOR ACKECT=1:1:ACKERR
Begin DoDot:1
+20 SET ACKTMP=@ACKGBL@(ACKECT)
+21 SET ACKFLD=$PIECE(ACKTMP,U,1)
SET ACKINT=$PIECE(ACKTMP,U,2)
SET ACKEXT=$PIECE(ACKTMP,U,3)
+22 SET ACKDTA=$SELECT(ACKEXT="":ACKINT,1:ACKEXT)
+23 SET ACKTAB=$SELECT($LENGTH(ACKDTA)>19:35,1:13+$LENGTH(ACKDTA)+2+5\5*5)
SET ACKLEN=80-ACKTAB
+24 WRITE !?2,ACKFLD_":",?13,$EXTRACT(ACKDTA,1,20)
+25 SET ACKMSG=$PIECE(ACKTMP,U,4)
SET ACKLF=0
+26 FOR
if ACKMSG=""
QUIT
Begin DoDot:2
+27 ; reset TXT (word wrap)
SET ACKTXT=$EXTRACT(ACKMSG,1,ACKLEN)
Begin DoDot:3
+28 IF ($EXTRACT(ACKTXT,ACKLEN)?1P)!($EXTRACT(ACKMSG,ACKLEN+1)?1P)
QUIT
+29 SET ACKI=0
IF $LENGTH(ACKTXT)=ACKLEN
FOR ACKI=ACKLEN:-1:0
if $EXTRACT(ACKTXT,ACKI)?1P
QUIT
+30 IF ACKI
SET ACKTXT=$EXTRACT(ACKTXT,1,ACKI)
QUIT
End DoDot:3
+31 if ACKLF
WRITE !
WRITE ?ACKTAB,ACKTXT
SET ACKLF=1
+32 SET ACKLN=ACKLN+1
DO PAUSE
if $DATA(DIRUT)
QUIT
+33 SET ACKMSG=$PIECE(ACKMSG,ACKTXT,2,999)
+34 FOR
if $EXTRACT(ACKMSG)'=" "
QUIT
SET ACKMSG=$EXTRACT(ACKMSG,2,999)
End DoDot:2
if $DATA(DIRUT)
QUIT
End DoDot:1
if $DATA(DIRUT)
QUIT
+35 ;
+36 ; all done
+37 IF '$DATA(DIRUT)
SET ACKLN=0
DO PAUSE
+38 ; return 1 if user chose to quit, 0 if they didn't
+39 QUIT $DATA(DIRUT)
+40 ;
PAUSE ;
+1 if ACKLN#15'=0
QUIT
+2 WRITE !!
+3 ; Return to Continue '^' to Exit
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
+4 WRITE !
+5 QUIT
+6 ;
ACKAPMNT(ACKVD,ACKVTME,ACKCLIN,ACKPAT) ;
+1 ;
+2 ; //First checks to see if Patient is an Inpatient if they are then
+3 ; //dont display this message.
+4 ; Checks to see if the visit entered corresponds to a Visit Within
+5 ; Appointment Management. If does'nt a warning is displayed - the
+6 ; can continue or quit. This is to remind/encorage users to enter
+7 ; visits first through Appointment Management then pick them up
+8 ; in Quasar.
+9 ;
+10 ; N VAIN D INP^VADPT I $P(VAIN(4),U,2)'="" Q 1
+11 ;
+12 NEW ACKK1,ACKT,ACKOKAY
+13 IF ACKVTME=""
GOTO MESSAG
+14 ;
+15 SET DFN=ACKPAT
SET VASD("C",ACKCLIN)=""
SET VASD("T")=ACKVD
SET VASD("F")=ACKVD
+16 SET VASD("W")="129"
+17 ; Call appointment utility
KILL ^UTILITY("VASD",$JOB)
DO SDA^VADPT
+18 ; Nothing returned=No appointment
IF '$DATA(^UTILITY("VASD",$JOB))
GOTO MESSAG
+19 ;
+20 SET ACKK1=""
SET ACKOKAY=0
+21 FOR
SET ACKK1=$ORDER(^UTILITY("VASD",$JOB,ACKK1))
if ACKK1=""!(ACKOKAY)
QUIT
Begin DoDot:1
+22 SET ACKT=$PIECE(^UTILITY("VASD",$JOB,ACKK1,"I"),U,1)
+23 SET ACKT=$PIECE(ACKT,".",2)
+24 IF ACKT=ACKVTME
SET ACKOKAY=1
End DoDot:1
+25 KILL ^UTILITY("VASD",$JOB)
+26 ;
+27 IF ACKOKAY
QUIT 1
+28 ;
MESSAG ;
+1 WRITE !!!,"WARNING -",!
+2 WRITE !,"You are Creating a Visit that does not exist within Appointment Management."
+3 WRITE !,"This Visit will not be displayed within Appointment Management.",!
+4 ;
+5 NEW DIR,DUOUT,DTOUT,DIRUT
OK2 SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("A")="Do you want to Continue "
+1 SET DIR("?")="Answer YES to continue with New Visit Entry or NO to quit."
+2 DO ^DIR
+3 IF Y?1"^"1.E
WRITE !,"Jumping not allowed.",!
GOTO OK2
+4 if $DATA(DIRUT)
SET Y=0
+5 if $DATA(DTOUT)
SET Y=0
+6 QUIT Y
+7 ;
