1 | ACKQCP1 ;AUG/JLTP BIR/PTD HCIOFO/BH-QUASAR/C&P Interface - CONTINUED ; [ 04/24/96 1:20 PM ]
|
---|
2 | ;;3.0;QUASAR;;Feb 11, 2000
|
---|
3 | ; Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
|
---|
4 | PULL ; Pulls QUASAR data into ACKC array to pass to AMIE package.
|
---|
5 | ; ENTER WITH: ACKD0=IFN from QUASAR Visit file, DFN=Patient#
|
---|
6 | ;
|
---|
7 | D DEM^VADPT S ACKQRAW=$G(^ACK(509850.6,ACKD0,4)),ACK0=^(0),ACK2=^(2) K ACKC
|
---|
8 | S ACKC(1)=" ",ACKC(2)="PATIENT: "_$$GET1^DIQ(2,DFN,.01)_" ("_$P(VADM(2),"^",2)_")" S Y=$P(ACK0,"^") I Y'="" X ^DD("DD") S ACKC(3)="A&SP CLINIC VISIT DATE: "_Y
|
---|
9 | S ACKDIV=$P(^ACK(509850.6,ACKD0,5),U,1)
|
---|
10 | S ACKDSTAT=$$GET1^DIQ(40.8,ACKDIV,1)
|
---|
11 | I ACKDIV'="" S ACKDIV=$$GET1^DIQ(40.8,ACKDIV,.01)
|
---|
12 | S ACKC(4)="DIVISION: "_$S($D(ACKDIV):ACKDIV,1:"No Division on file for Visit")
|
---|
13 | S ACKC(5)="STATION NUMBER: "_$S($D(ACKDSTAT):ACKDSTAT,1:"No station Number set up for Division")
|
---|
14 | ;
|
---|
15 | ;
|
---|
16 | F100 S ACKC(6)=" ",ACKCNT=7 I $O(^ACK(509850.6,ACKD0,100,0)) S ACKC(ACKCNT)="REVIEW OF MEDICAL RECORDS:" S ACKFLD=100 D FLD S ACKCNT=ACKCNT+1,ACKC(ACKCNT)=" "
|
---|
17 | F101 S ACKCNT=ACKCNT+1 I $O(^ACK(509850.6,ACKD0,101,0)) S ACKC(ACKCNT)="MEDICAL HISTORY (SUBJECTIVE COMPLAINTS):" S ACKFLD=101 D FLD S ACKCNT=ACKCNT+1,ACKC(ACKCNT)=" "
|
---|
18 | F102 S ACKCNT=ACKCNT+1,ACKC(ACKCNT)="PHYSICAL EXAMINATION (OBJECTIVE FINDINGS):",ACKCNT=ACKCNT+1
|
---|
19 | S X="R500: ^R1000: ^R2000: ^R3000: ^R4000: ^R AVG: ^L500: ^L1000: ^L2000: ^L3000: ^L4000: ^L AVG: "
|
---|
20 | S ACKC(ACKCNT)="Pure Tone Results:",ACKCNT=ACKCNT+1
|
---|
21 | F I=1:1:6 S X1=$P(X,U,I)_$$J($P(ACKQRAW,U,I)),X1=X1_" "_$P(X,U,I+6)_$$J($P(ACKQRAW,U,I+6)),ACKC(ACKCNT)=X1,ACKCNT=ACKCNT+1
|
---|
22 | S ACKC(ACKCNT)=" ",ACKCNT=ACKCNT+1,ACKC(ACKCNT)="Speech Recognition Scores:",ACKCNT=ACKCNT+1,ACKC(ACKCNT)="CNC R: "_$$J($P(ACKQRAW,U,13))_" CNC L: "_$$J($P(ACKQRAW,U,14)),ACKCNT=ACKCNT+1
|
---|
23 | S ACKC(ACKCNT)="W22 R: "_$$J($P(ACKQRAW,U,15))_" W22 L: "_$$J($P(ACKQRAW,U,16)),ACKCNT=ACKCNT+1,ACKC(ACKCNT)=" "
|
---|
24 | I $O(^ACK(509850.6,ACKD0,102,0)) S ACKFLD=102 D FLD S ACKCNT=ACKCNT+1,ACKC(ACKCNT)=" "
|
---|
25 | F103 S ACKCNT=ACKCNT+1 I $O(^ACK(509850.6,ACKD0,103,0)) S ACKC(ACKCNT)="DIAGNOSTIC AND CLINICAL TESTS:" S ACKFLD=103 D FLD S ACKCNT=ACKCNT+1,ACKC(ACKCNT)=" "
|
---|
26 | F104 S ACKCNT=ACKCNT+1 I $O(^ACK(509850.6,ACKD0,104,0)) S ACKC(ACKCNT)="DIAGNOSIS:" S ACKFLD=104 D FLD S ACKCNT=ACKCNT+1,ACKC(ACKCNT)=" "
|
---|
27 | S ACKCNT=ACKCNT+1,Y=$P(ACKQRAW,"^",18) I Y'="" X ^DD("DD") S ACKC(ACKCNT)="Completion Date: "_Y,ACKCNT=ACKCNT+1,ACKC(ACKCNT)=$P($G(ACKQRAW),"^",17),ACKCNT=ACKCNT+1,ACKC(ACKCNT)=$P($G(ACKQRAW),"^",24),ACKCNT=ACKCNT+1,ACKC(ACKCNT)=" "
|
---|
28 | S ACKCNT=ACKCNT+1,Y=$P(ACKQRAW,"^",20) I Y'="" X ^DD("DD") S ACKC(ACKCNT)="Adequation Date: "_Y,ACKCNT=ACKCNT+1,ACKC(ACKCNT)=$P($G(ACKQRAW),"^",19),ACKCNT=ACKCNT+1,ACKC(ACKCNT)=$P($G(ACKQRAW),"^",25)
|
---|
29 | Q
|
---|
30 | ;
|
---|
31 | ;
|
---|
32 | FLD ; Build TMP array for audiometric fields.
|
---|
33 | S ACKI=0 F S ACKI=$O(^ACK(509850.6,ACKD0,ACKFLD,ACKI)) Q:'ACKI S ACKCNT=ACKCNT+1,ACKC(ACKCNT)=^ACK(509850.6,ACKD0,ACKFLD,ACKI,0)
|
---|
34 | Q
|
---|
35 | ;
|
---|
36 | J(X) ; JUSTIFY PROPERLY
|
---|
37 | Q $S(X="":"",1:$J(X,3,0))
|
---|
38 | ;
|
---|
39 | CP ; Select any C&P clinic visit.
|
---|
40 | S DIC=509850.6,DIC(0)="AEMQZ",DIC("A")="Select C&P VISIT DATE: ",DIC("S")="I $P(^(0),U,9)" W ! D ^DIC K DIC Q:Y<0 S ACKD0=+Y,DFN=+$P(Y(0),"^",2)
|
---|
41 | Q
|
---|
42 | ;
|
---|
43 | PULL2 ; Pulls QUASAR data into ACKC array to display audiometric fields.
|
---|
44 | ; Called from New Visit function.
|
---|
45 | ;
|
---|
46 | ; ENTER WITH: ACKD0=IFN from QUASAR Visit file, DFN=Patient#
|
---|
47 | ;
|
---|
48 | D DEM^VADPT S ACKQRAW=$G(^ACK(509850.6,ACKD0,4)),ACK0=^(0),ACK2=^(2) K ACKC
|
---|
49 | S X="R500: ^R1000: ^R2000: ^R3000: ^R4000: ^R AVG: ^L500: ^L1000: ^L2000: ^L3000: ^L4000: ^L AVG: "
|
---|
50 | S ACKC(1)="PURE TONE RESULTS:"
|
---|
51 | F I=1:1:6 S X1=$P(X,U,I)_$$J($P(ACKQRAW,U,I)),X1=X1_" "_$P(X,U,I+6)_$$J($P(ACKQRAW,U,I+6)),ACKC(I+1)=X1
|
---|
52 | S ACKC(8)="SPEECH RECOGNITION SCORES:",ACKC(9)="CNC R: "_$$J($P(ACKQRAW,U,13))_" CNC L: "_$$J($P(ACKQRAW,U,14))
|
---|
53 | S ACKC(10)="W22 R: "_$$J($P(ACKQRAW,U,15))_" W22 L: "_$$J($P(ACKQRAW,U,16)),ACKC(11)=" "
|
---|
54 | Q
|
---|
55 | ;
|
---|