ACKQAS1 ;AUG/JLTP BIR/PTD HCIOFO/BH-New Clinic Visits - CONTINUED ; [ 04/12/96 10:38 AM ]
;;3.0;QUASAR;;Feb 11, 2000
;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
;
LAMD(DFN) ;FIND LATEST AUDIOMETRIC DATA FOR A PATIENT
N ACKC,ACKD0,ACKLAMD,X
S X=$O(^ACK(509850.6,"AMD",DFN,0)),ACKD0=$O(^ACK(509850.6,"AMD",DFN,+X,0)),ACKLAMD=9999999-X
I 'X!('$D(^ACK(509850.6,+ACKD0,0))) Q 0
W !!,$C(7),"Audiometric testing for this patient last completed ",$$NUMDT^ACKQUTL(ACKLAMD),"."
D PULL2^ACKQCP1 W ! S ACKC=0 F S ACKC=$O(ACKC(ACKC)) Q:('ACKC)!(ACKC>11) W !,ACKC(ACKC)
LAMDR S DIR(0)="Y",DIR("A")="Do you wish to use these scores ",DIR("?",1)="If you say YES, I will use these existing audiometric scores and",DIR("?")="you will not be asked to enter audiometric data for the current exam."
D ^DIR K DIR
I X?1"^"1.E W !,"Jumping not allowed.",! G LAMDR
I Y'=1 K Y Q 0
K Y Q ACKLAMD_U_$G(^ACK(509850.6,ACKD0,4))
Q
;
; -----------------------------------------------------------------
;
DCXFM ; INPUT TRANSFORM FOR DIAG CODE MODIFIER
; These Modifiers are no longer used after the install for QSR V.3.0
W !,$C(7),"After the installation of QUASAR V.3.0 this field is no longer in use !" K X
Q
;
PCXFM ; INPUT TRANSFORM FOR PROC CODE MODIFIER
; These Modifiers are no longer used after the install for QSR V.3.0
W !,$C(7),"After the installation of QUASAR V.3.0 this field is no longer in use !" K X
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HACKQAS1 1468 printed Nov 22, 2024@17:41:42 Page 2
ACKQAS1 ;AUG/JLTP BIR/PTD HCIOFO/BH-New Clinic Visits - CONTINUED ; [ 04/12/96 10:38 AM ]
+1 ;;3.0;QUASAR;;Feb 11, 2000
+2 ;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
+3 ;
LAMD(DFN) ;FIND LATEST AUDIOMETRIC DATA FOR A PATIENT
+1 NEW ACKC,ACKD0,ACKLAMD,X
+2 SET X=$ORDER(^ACK(509850.6,"AMD",DFN,0))
SET ACKD0=$ORDER(^ACK(509850.6,"AMD",DFN,+X,0))
SET ACKLAMD=9999999-X
+3 IF 'X!('$DATA(^ACK(509850.6,+ACKD0,0)))
QUIT 0
+4 WRITE !!,$CHAR(7),"Audiometric testing for this patient last completed ",$$NUMDT^ACKQUTL(ACKLAMD),"."
+5 DO PULL2^ACKQCP1
WRITE !
SET ACKC=0
FOR
SET ACKC=$ORDER(ACKC(ACKC))
if ('ACKC)!(ACKC>11)
QUIT
WRITE !,ACKC(ACKC)
LAMDR SET DIR(0)="Y"
SET DIR("A")="Do you wish to use these scores "
SET DIR("?",1)="If you say YES, I will use these existing audiometric scores and"
SET DIR("?")="you will not be asked to enter audiometric data for the current exam."
+1 DO ^DIR
KILL DIR
+2 IF X?1"^"1.E
WRITE !,"Jumping not allowed.",!
GOTO LAMDR
+3 IF Y'=1
KILL Y
QUIT 0
+4 KILL Y
QUIT ACKLAMD_U_$GET(^ACK(509850.6,ACKD0,4))
+5 QUIT
+6 ;
+7 ; -----------------------------------------------------------------
+8 ;
DCXFM ; INPUT TRANSFORM FOR DIAG CODE MODIFIER
+1 ; These Modifiers are no longer used after the install for QSR V.3.0
+2 WRITE !,$CHAR(7),"After the installation of QUASAR V.3.0 this field is no longer in use !"
KILL X
+3 QUIT
+4 ;
PCXFM ; INPUT TRANSFORM FOR PROC CODE MODIFIER
+1 ; These Modifiers are no longer used after the install for QSR V.3.0
+2 WRITE !,$CHAR(7),"After the installation of QUASAR V.3.0 this field is no longer in use !"
KILL X
+3 QUIT
+4 ;
