ACKQASU2 ;HCIOFO/BH-NEW/EDIT VISIT QUASAR UTILITIES ; 04/01/99
;;3.0;QUASAR;**1**;Feb 11, 2000
;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
;
;
ADD S ACKCNT=ACKCNT+1 Q
;
;
;
POST(ACKVIEN) ;
K DIRUT,DTOUT
;
N ACKEXPT,ACKK1,ACKK2,ACKARR,ACK,ACKSC,VAEL,ACKVSC,ACKVAO,ACKVRAD,ACKVENV
;
; Clear away Update PCE Problem list and Diag provider if invalid
N ACKPROB,ACKDD,ACKDREC,ACKDUP,ACKDPROV,ACKDIAG
S ACKDIAG=0
S ACKPROB=$$PROB^ACKQUTL4(ACKPCE,ACKDIV)
F S ACKDIAG=$O(^ACK(509850.6,ACKVIEN,1,ACKDIAG)) Q:'ACKDIAG D
. S ACKDREC=$G(^ACK(509850.6,ACKVIEN,1,ACKDIAG,0)) Q:'ACKDREC
. S ACKDUP=$P(ACKDREC,"^",3)
. S ACKDPROV=$P(ACKDREC,"^",4)
. I 'ACKPROB D Q
. . I ACKDUP'=""!(ACKDPROV'="") D
. . . K ACKDD
. . . S ACKDD(509850.63,ACKDIAG_","_ACKVIEN_",",.13)=""
. . . S ACKDD(509850.63,ACKDIAG_","_ACKVIEN_",",.14)=""
. . . D FILE^DIE("","ACKDD","") K ACKDD
. I ACKPROB D Q
. . I 'ACKDUP,ACKDPROV'="" D
. . . K ACKDD
. . . S ACKDD(509850.63,ACKDIAG_","_ACKVIEN_",",.14)=""
. . . S ACKDD(509850.63,ACKDIAG_","_ACKVIEN_",",.13)=""
. . . D FILE^DIE("","ACKDD","") K ACKDD
;
;------------------------------------------------
D ELIG^VADPT S ACKSC=$P(VAEL(3),U,1) K VAEL
;
GETDATA D GETS^DIQ(509850.6,ACKVIEN,"20;25;30;35","I","ACK")
;
S ACKVSC=ACK(509850.6,ACKVIEN_",",20,"I")
S ACKVAO=ACK(509850.6,ACKVIEN_",",25,"I")
S ACKVRAD=ACK(509850.6,ACKVIEN_",",30,"I")
S ACKVENV=ACK(509850.6,ACKVIEN_",",35,"I")
;
K ACK
;
NULL ; NUll out fields that should not bo present or have been set
; incorrectly
;
I ACKSC=0,ACKVSC'="" S ACK(509850.6,ACKVIEN_",",20)="" S ACKVSC=""
;
I ACKAO=0,ACKVAO'="" S ACK(509850.6,ACKVIEN_",",25)=""
I ACKRAD=0,ACKVRAD'="" S ACK(509850.6,ACKVIEN_",",30)=""
I ACKENV=0,ACKVENV'="" S ACK(509850.6,ACKVIEN_",",35)=""
;
I ACKSC=1,ACKVSC=1,ACKVAO'="" S ACK(509850.6,ACKVIEN_",",25)=""
I ACKSC=1,ACKVSC=1,ACKVRAD'="" S ACK(509850.6,ACKVIEN_",",30)=""
I ACKSC=1,ACKVSC=1,ACKVENV'="" S ACK(509850.6,ACKVIEN_",",35)=""
I $D(ACK) D FILE^DIE("","ACK") K ACK
;
D CHKVST^ACKQUTL8(ACKVIEN,.ACKARR,1)
;
I ACKARR=0 D MINIMUM G EXIT ; Minimum data not entered
;
I ACKARR=-1 D CORRUPT,DELETE S ACKOUT=2 ; Corrupt
;
I ACKARR=3 S ACKOUT=1 G EXIT ; Everything is okay
;
I 'ACKPCE,ACKARR=2 S ACKOUT=1 G EXIT ; Interface off and no Quasar
; ; errors - Everything is okay
;
I ACKPCE D
. D PCE
. S ACKK1="" F S ACKK1=$O(ACKARR(1,ACKK1)) Q:ACKK1="" D
. . W !," ",ACKARR(1,ACKK1)
. S ACKK2="" F S ACKK2=$O(ACKARR(2,ACKK2)) Q:ACKK2="" D
. . W !," ",ACKARR(2,ACKK2)
. S ACKEXPT=$$EXPT(ACKVIEN)
. W !! D CHOICE1 W !!
;
I 'ACKPCE D
. D QUASAR
. S ACKK1="" F S ACKK1=$O(ACKARR(1,ACKK1)) Q:ACKK1="" D
. . W !," ",ACKARR(1,ACKK1)
. W !! D CHOICE W !!
;
EXIT ; One way out
Q ACKOUT
;
;
MINIMUM ; Minimum Data not entered. If New Visit user can either delete or
; re-edit the visit if user is editing a visit user only has option
; to re-edit the visit.
;
D DISPLAY
I ACKVISIT="NEW" D Q
. K DIR
. S DIR("A")="Enter RETURN to Re-Edit Visit or '^' to Quit and Delete"
. S DIR(0)="E" D ^DIR K DIR
. I $D(DTOUT)!$D(DIRUT) S X="^" ; Time out or Quit
. I X="^" S ACKOUT=2 D DELETE Q
. S ACKOUT=0 Q ; Entered <Return>
;
I ACKVISIT="EDIT" D Q
. K DIR
. S DIR("?")="This option will not Quit until Quasars Minimum Data Requirements have been entered"
. S DIR("A")="Press RETURN to Re-edit Visit",DIR(0)="E"
. D ^DIR
. S ACKOUT=0 Q
;
;
DELETE ; Delete the entry
;
W !!,$C(7),"<<INCOMPLETE RECORD DELETED!!>>",!!
S DIK="^ACK(509850.6,",DA=ACKVIEN D ^DIK
Q
;
;
CORRUPT ; Display corrupt data message
;
W !!,"ERROR - This record has become corrupted.",!
;
Q
;
QUASAR ; Display Quasar heading and missing fields
;
W !!," WARNING - ",!
W " The following are fields required by QUASAR that have not been entered.",!
W " Enter <RETURN> to re-enter this function or '^' to quit.",!!
;
Q
;
PCE ; Display PCE missing fields
;
W @IOF
W " WARNING - ",!!
W " The following are fields required by QUASAR & PCE that have not been entered.",!
Q
;
PCE1 W !," '^' Quit & File the A&SP visit but do not send incomplete A&SP"
W !," visit to PCE. Or,"
;
Q
;
CHOICE ; Display choice - either enter '^' to quit entry or <Return> to
; re-enter the template
;
K DIR S DIR(0)="E" D ^DIR K DIR
I +Y=1 S ACKOUT=0
I +Y=0 S ACKOUT=1
S:$D(DIRUT) ACKOUT=1
K DIRUT,DTOUT
Q
;
CHOICE1 ; Prompt for PCE choice - An Exception may not be set when the PCE Inte-
; -face is on so dont prompt user with 'Send to PCE' options if no
; exception is present (i.e. ACKEXPT=0).
;
; If EXCEPTION '^' - Quit but not send to PCE
; R - Re-enter the template
; C - Continue send with errors
; '^' - Returns 2 C - Returns 1 R - Returns 0
;
; If not EXCEPTION '^' - Quit
; R - Re-enter the template
; C - Continue file with errors
; '^' & C - Returns 2 R - Returns 0
;
DISP I ACKEXPT D PCE1
S DIR("A")=" (C)ontinue or (R)enter "
S DIR("B")="R"
I ACKEXPT S DIR("?")=" Enter 'R' to Re-enter this function and amend data, 'C' to Continue and send incomplete A&SP visit data to PCE or '^' to exit without sending to PCE."
I ACKEXPT'=1 S DIR("?")=" Enter 'R' to Re-enter this function and amend data or 'C' to Continue and file incomplete"
I ACKEXPT S DIR(0)="S^R:Re-enter this function & amend data;C:Continue & send incomplete A&SP visit data to PCE;"
I ACKEXPT'=1 S DIR(0)="S^R:Re-enter this function & amend data;C:Continue & file incomplete;"
D ^DIR K DIR
S:$D(DTOUT) X=U
S:$D(DIRUT) ACKOUT=2
I ACKEXPT I X="c"!(X="C") S ACKOUT=1
I ACKEXPT'=1 I X="c"!(X="C") S ACKOUT=2
I X="r"!(X="R") S ACKOUT=0
I X="^" S ACKOUT=2
;
Q
;
UTLAUD ;
N ACK,ACKRAV,ACKLAV,ACKI,ACKR1,ACKR2,ACKR3,ACKR4,ACKL1,ACKL2,ACKL3,ACKL4
N ACKAR
; Sets previous vist audiometric data into file
;
I $L($G(ACKLAMD))>7 D Q
. F ACKI=1:1:16 S $P(^ACK(509850.6,ACKVIEN,4),U,ACKI)=$P(ACKLAMD,U,ACKI+1)
;
;
; Calculates the average of the scores and sets the results into
; visit file
;
D VALUES
;
; Cannot calculate average if a null value exists
I ACKR1=""!(ACKR2="")!(ACKR3="")!(ACKR4="") G LEFT
S ACKRAV=ACKR1+ACKR2+ACKR3+ACKR4/4+.5\1 S:ACKRAV<0 ACKRAV=0
S ACKAR(509850.6,ACKVIEN_",","4.06")=ACKRAV
;
LEFT ; Cannot calculate average if a null value exists
I ACKL1=""!(ACKL2="")!(ACKL3="")!(ACKL4="") Q
S ACKLAV=ACKL1+ACKL2+ACKL3+ACKL4/4+.5\1 S:ACKLAV<0 ACKLAV=0
S ACKAR(509850.6,ACKVIEN_",","4.12")=ACKLAV
D FILE^DIE("K","ACKAR") K ACKAR
;
Q
;
VALUES ; Get value for calculation
K ACK
D GETS^DIQ(509850.6,ACKVIEN,"4.02;4.03;4.04;4.05;4.08;4.09;4.1;4.11","I","ACK")
;
S ACKR1=ACK(509850.6,ACKVIEN_",",4.02,"I")
S ACKR2=ACK(509850.6,ACKVIEN_",",4.03,"I")
S ACKR3=ACK(509850.6,ACKVIEN_",",4.04,"I")
S ACKR4=ACK(509850.6,ACKVIEN_",",4.05,"I")
;
S ACKL1=ACK(509850.6,ACKVIEN_",",4.08,"I")
S ACKL2=ACK(509850.6,ACKVIEN_",",4.09,"I")
S ACKL3=ACK(509850.6,ACKVIEN_",",4.1,"I")
S ACKL4=ACK(509850.6,ACKVIEN_",",4.11,"I")
;
K ACK
Q
;
EXPT(ACKVIEN) ; Passes back 1 or zero depending if visit has an Exception
; entry set up.
N ACKEX
S ACKEX=$$GET1^DIQ(509850.6,ACKVIEN_",",900,"I") I ACKEX="" Q 0
I '$D(^ACK(509850.6,"AEX",ACKEX,ACKVIEN)) Q 0
Q 1
;
;
DISPLAY ;
W !!,"The following field(s) are required by QUASAR but have not been entered.",!!
I $$GET1^DIQ(509850.6,ACKVIEN_",",5)="" W " CDR Account",!
I $$GET1^DIQ(509850.6,ACKVIEN_",",55)="" W " Appointment Time",!
W !!
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HACKQASU2 8093 printed Dec 13, 2024@02:31:47 Page 2
ACKQASU2 ;HCIOFO/BH-NEW/EDIT VISIT QUASAR UTILITIES ; 04/01/99
+1 ;;3.0;QUASAR;**1**;Feb 11, 2000
+2 ;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
+3 ;
+4 ;
ADD SET ACKCNT=ACKCNT+1
QUIT
+1 ;
+2 ;
+3 ;
POST(ACKVIEN) ;
+1 KILL DIRUT,DTOUT
+2 ;
+3 NEW ACKEXPT,ACKK1,ACKK2,ACKARR,ACK,ACKSC,VAEL,ACKVSC,ACKVAO,ACKVRAD,ACKVENV
+4 ;
+5 ; Clear away Update PCE Problem list and Diag provider if invalid
+6 NEW ACKPROB,ACKDD,ACKDREC,ACKDUP,ACKDPROV,ACKDIAG
+7 SET ACKDIAG=0
+8 SET ACKPROB=$$PROB^ACKQUTL4(ACKPCE,ACKDIV)
+9 FOR
SET ACKDIAG=$ORDER(^ACK(509850.6,ACKVIEN,1,ACKDIAG))
if 'ACKDIAG
QUIT
Begin DoDot:1
+10 SET ACKDREC=$GET(^ACK(509850.6,ACKVIEN,1,ACKDIAG,0))
if 'ACKDREC
QUIT
+11 SET ACKDUP=$PIECE(ACKDREC,"^",3)
+12 SET ACKDPROV=$PIECE(ACKDREC,"^",4)
+13 IF 'ACKPROB
Begin DoDot:2
+14 IF ACKDUP'=""!(ACKDPROV'="")
Begin DoDot:3
+15 KILL ACKDD
+16 SET ACKDD(509850.63,ACKDIAG_","_ACKVIEN_",",.13)=""
+17 SET ACKDD(509850.63,ACKDIAG_","_ACKVIEN_",",.14)=""
+18 DO FILE^DIE("","ACKDD","")
KILL ACKDD
End DoDot:3
End DoDot:2
QUIT
+19 IF ACKPROB
Begin DoDot:2
+20 IF 'ACKDUP
IF ACKDPROV'=""
Begin DoDot:3
+21 KILL ACKDD
+22 SET ACKDD(509850.63,ACKDIAG_","_ACKVIEN_",",.14)=""
+23 SET ACKDD(509850.63,ACKDIAG_","_ACKVIEN_",",.13)=""
+24 DO FILE^DIE("","ACKDD","")
KILL ACKDD
End DoDot:3
End DoDot:2
QUIT
End DoDot:1
+25 ;
+26 ;------------------------------------------------
+27 DO ELIG^VADPT
SET ACKSC=$PIECE(VAEL(3),U,1)
KILL VAEL
+28 ;
GETDATA DO GETS^DIQ(509850.6,ACKVIEN,"20;25;30;35","I","ACK")
+1 ;
+2 SET ACKVSC=ACK(509850.6,ACKVIEN_",",20,"I")
+3 SET ACKVAO=ACK(509850.6,ACKVIEN_",",25,"I")
+4 SET ACKVRAD=ACK(509850.6,ACKVIEN_",",30,"I")
+5 SET ACKVENV=ACK(509850.6,ACKVIEN_",",35,"I")
+6 ;
+7 KILL ACK
+8 ;
NULL ; NUll out fields that should not bo present or have been set
+1 ; incorrectly
+2 ;
+3 IF ACKSC=0
IF ACKVSC'=""
SET ACK(509850.6,ACKVIEN_",",20)=""
SET ACKVSC=""
+4 ;
+5 IF ACKAO=0
IF ACKVAO'=""
SET ACK(509850.6,ACKVIEN_",",25)=""
+6 IF ACKRAD=0
IF ACKVRAD'=""
SET ACK(509850.6,ACKVIEN_",",30)=""
+7 IF ACKENV=0
IF ACKVENV'=""
SET ACK(509850.6,ACKVIEN_",",35)=""
+8 ;
+9 IF ACKSC=1
IF ACKVSC=1
IF ACKVAO'=""
SET ACK(509850.6,ACKVIEN_",",25)=""
+10 IF ACKSC=1
IF ACKVSC=1
IF ACKVRAD'=""
SET ACK(509850.6,ACKVIEN_",",30)=""
+11 IF ACKSC=1
IF ACKVSC=1
IF ACKVENV'=""
SET ACK(509850.6,ACKVIEN_",",35)=""
+12 IF $DATA(ACK)
DO FILE^DIE("","ACK")
KILL ACK
+13 ;
+14 DO CHKVST^ACKQUTL8(ACKVIEN,.ACKARR,1)
+15 ;
+16 ; Minimum data not entered
IF ACKARR=0
DO MINIMUM
GOTO EXIT
+17 ;
+18 ; Corrupt
IF ACKARR=-1
DO CORRUPT
DO DELETE
SET ACKOUT=2
+19 ;
+20 ; Everything is okay
IF ACKARR=3
SET ACKOUT=1
GOTO EXIT
+21 ;
+22 ; Interface off and no Quasar
IF 'ACKPCE
IF ACKARR=2
SET ACKOUT=1
GOTO EXIT
+23 ; ; errors - Everything is okay
+24 ;
+25 IF ACKPCE
Begin DoDot:1
+26 DO PCE
+27 SET ACKK1=""
FOR
SET ACKK1=$ORDER(ACKARR(1,ACKK1))
if ACKK1=""
QUIT
Begin DoDot:2
+28 WRITE !," ",ACKARR(1,ACKK1)
End DoDot:2
+29 SET ACKK2=""
FOR
SET ACKK2=$ORDER(ACKARR(2,ACKK2))
if ACKK2=""
QUIT
Begin DoDot:2
+30 WRITE !," ",ACKARR(2,ACKK2)
End DoDot:2
+31 SET ACKEXPT=$$EXPT(ACKVIEN)
+32 WRITE !!
DO CHOICE1
WRITE !!
End DoDot:1
+33 ;
+34 IF 'ACKPCE
Begin DoDot:1
+35 DO QUASAR
+36 SET ACKK1=""
FOR
SET ACKK1=$ORDER(ACKARR(1,ACKK1))
if ACKK1=""
QUIT
Begin DoDot:2
+37 WRITE !," ",ACKARR(1,ACKK1)
End DoDot:2
+38 WRITE !!
DO CHOICE
WRITE !!
End DoDot:1
+39 ;
EXIT ; One way out
+1 QUIT ACKOUT
+2 ;
+3 ;
MINIMUM ; Minimum Data not entered. If New Visit user can either delete or
+1 ; re-edit the visit if user is editing a visit user only has option
+2 ; to re-edit the visit.
+3 ;
+4 DO DISPLAY
+5 IF ACKVISIT="NEW"
Begin DoDot:1
+6 KILL DIR
+7 SET DIR("A")="Enter RETURN to Re-Edit Visit or '^' to Quit and Delete"
+8 SET DIR(0)="E"
DO ^DIR
KILL DIR
+9 ; Time out or Quit
IF $DATA(DTOUT)!$DATA(DIRUT)
SET X="^"
+10 IF X="^"
SET ACKOUT=2
DO DELETE
QUIT
+11 ; Entered <Return>
SET ACKOUT=0
QUIT
End DoDot:1
QUIT
+12 ;
+13 IF ACKVISIT="EDIT"
Begin DoDot:1
+14 KILL DIR
+15 SET DIR("?")="This option will not Quit until Quasars Minimum Data Requirements have been entered"
+16 SET DIR("A")="Press RETURN to Re-edit Visit"
SET DIR(0)="E"
+17 DO ^DIR
+18 SET ACKOUT=0
QUIT
End DoDot:1
QUIT
+19 ;
+20 ;
DELETE ; Delete the entry
+1 ;
+2 WRITE !!,$CHAR(7),"<<INCOMPLETE RECORD DELETED!!>>",!!
+3 SET DIK="^ACK(509850.6,"
SET DA=ACKVIEN
DO ^DIK
+4 QUIT
+5 ;
+6 ;
CORRUPT ; Display corrupt data message
+1 ;
+2 WRITE !!,"ERROR - This record has become corrupted.",!
+3 ;
+4 QUIT
+5 ;
QUASAR ; Display Quasar heading and missing fields
+1 ;
+2 WRITE !!," WARNING - ",!
+3 WRITE " The following are fields required by QUASAR that have not been entered.",!
+4 WRITE " Enter <RETURN> to re-enter this function or '^' to quit.",!!
+5 ;
+6 QUIT
+7 ;
PCE ; Display PCE missing fields
+1 ;
+2 WRITE @IOF
+3 WRITE " WARNING - ",!!
+4 WRITE " The following are fields required by QUASAR & PCE that have not been entered.",!
+5 QUIT
+6 ;
PCE1 WRITE !," '^' Quit & File the A&SP visit but do not send incomplete A&SP"
+1 WRITE !," visit to PCE. Or,"
+2 ;
+3 QUIT
+4 ;
CHOICE ; Display choice - either enter '^' to quit entry or <Return> to
+1 ; re-enter the template
+2 ;
+3 KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
+4 IF +Y=1
SET ACKOUT=0
+5 IF +Y=0
SET ACKOUT=1
+6 if $DATA(DIRUT)
SET ACKOUT=1
+7 KILL DIRUT,DTOUT
+8 QUIT
+9 ;
CHOICE1 ; Prompt for PCE choice - An Exception may not be set when the PCE Inte-
+1 ; -face is on so dont prompt user with 'Send to PCE' options if no
+2 ; exception is present (i.e. ACKEXPT=0).
+3 ;
+4 ; If EXCEPTION '^' - Quit but not send to PCE
+5 ; R - Re-enter the template
+6 ; C - Continue send with errors
+7 ; '^' - Returns 2 C - Returns 1 R - Returns 0
+8 ;
+9 ; If not EXCEPTION '^' - Quit
+10 ; R - Re-enter the template
+11 ; C - Continue file with errors
+12 ; '^' & C - Returns 2 R - Returns 0
+13 ;
DISP IF ACKEXPT
DO PCE1
+1 SET DIR("A")=" (C)ontinue or (R)enter "
+2 SET DIR("B")="R"
+3 IF ACKEXPT
SET DIR("?")=" Enter 'R' to Re-enter this function and amend data, 'C' to Continue and send incomplete A&SP visit data to PCE or '^' to exit without sending to PCE."
+4 IF ACKEXPT'=1
SET DIR("?")=" Enter 'R' to Re-enter this function and amend data or 'C' to Continue and file incomplete"
+5 IF ACKEXPT
SET DIR(0)="S^R:Re-enter this function & amend data;C:Continue & send incomplete A&SP visit data to PCE;"
+6 IF ACKEXPT'=1
SET DIR(0)="S^R:Re-enter this function & amend data;C:Continue & file incomplete;"
+7 DO ^DIR
KILL DIR
+8 if $DATA(DTOUT)
SET X=U
+9 if $DATA(DIRUT)
SET ACKOUT=2
+10 IF ACKEXPT
IF X="c"!(X="C")
SET ACKOUT=1
+11 IF ACKEXPT'=1
IF X="c"!(X="C")
SET ACKOUT=2
+12 IF X="r"!(X="R")
SET ACKOUT=0
+13 IF X="^"
SET ACKOUT=2
+14 ;
+15 QUIT
+16 ;
UTLAUD ;
+1 NEW ACK,ACKRAV,ACKLAV,ACKI,ACKR1,ACKR2,ACKR3,ACKR4,ACKL1,ACKL2,ACKL3,ACKL4
+2 NEW ACKAR
+3 ; Sets previous vist audiometric data into file
+4 ;
+5 IF $LENGTH($GET(ACKLAMD))>7
Begin DoDot:1
+6 FOR ACKI=1:1:16
SET $PIECE(^ACK(509850.6,ACKVIEN,4),U,ACKI)=$PIECE(ACKLAMD,U,ACKI+1)
End DoDot:1
QUIT
+7 ;
+8 ;
+9 ; Calculates the average of the scores and sets the results into
+10 ; visit file
+11 ;
+12 DO VALUES
+13 ;
+14 ; Cannot calculate average if a null value exists
+15 IF ACKR1=""!(ACKR2="")!(ACKR3="")!(ACKR4="")
GOTO LEFT
+16 SET ACKRAV=ACKR1+ACKR2+ACKR3+ACKR4/4+.5\1
if ACKRAV<0
SET ACKRAV=0
+17 SET ACKAR(509850.6,ACKVIEN_",","4.06")=ACKRAV
+18 ;
LEFT ; Cannot calculate average if a null value exists
+1 IF ACKL1=""!(ACKL2="")!(ACKL3="")!(ACKL4="")
QUIT
+2 SET ACKLAV=ACKL1+ACKL2+ACKL3+ACKL4/4+.5\1
if ACKLAV<0
SET ACKLAV=0
+3 SET ACKAR(509850.6,ACKVIEN_",","4.12")=ACKLAV
+4 DO FILE^DIE("K","ACKAR")
KILL ACKAR
+5 ;
+6 QUIT
+7 ;
VALUES ; Get value for calculation
+1 KILL ACK
+2 DO GETS^DIQ(509850.6,ACKVIEN,"4.02;4.03;4.04;4.05;4.08;4.09;4.1;4.11","I","ACK")
+3 ;
+4 SET ACKR1=ACK(509850.6,ACKVIEN_",",4.02,"I")
+5 SET ACKR2=ACK(509850.6,ACKVIEN_",",4.03,"I")
+6 SET ACKR3=ACK(509850.6,ACKVIEN_",",4.04,"I")
+7 SET ACKR4=ACK(509850.6,ACKVIEN_",",4.05,"I")
+8 ;
+9 SET ACKL1=ACK(509850.6,ACKVIEN_",",4.08,"I")
+10 SET ACKL2=ACK(509850.6,ACKVIEN_",",4.09,"I")
+11 SET ACKL3=ACK(509850.6,ACKVIEN_",",4.1,"I")
+12 SET ACKL4=ACK(509850.6,ACKVIEN_",",4.11,"I")
+13 ;
+14 KILL ACK
+15 QUIT
+16 ;
EXPT(ACKVIEN) ; Passes back 1 or zero depending if visit has an Exception
+1 ; entry set up.
+2 NEW ACKEX
+3 SET ACKEX=$$GET1^DIQ(509850.6,ACKVIEN_",",900,"I")
IF ACKEX=""
QUIT 0
+4 IF '$DATA(^ACK(509850.6,"AEX",ACKEX,ACKVIEN))
QUIT 0
+5 QUIT 1
+6 ;
+7 ;
DISPLAY ;
+1 WRITE !!,"The following field(s) are required by QUASAR but have not been entered.",!!
+2 IF $$GET1^DIQ(509850.6,ACKVIEN_",",5)=""
WRITE " CDR Account",!
+3 IF $$GET1^DIQ(509850.6,ACKVIEN_",",55)=""
WRITE " Appointment Time",!
+4 WRITE !!
+5 QUIT
+6 ;
