56 lines
3.8 KiB
Mathematica
56 lines
3.8 KiB
Mathematica
ACKQCP1 ;AUG/JLTP BIR/PTD HCIOFO/BH-QUASAR/C&P Interface - CONTINUED ; [ 04/24/96 1:20 PM ]
|
|
;;3.0;QUASAR;;Feb 11, 2000
|
|
; Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
|
|
PULL ; Pulls QUASAR data into ACKC array to pass to AMIE package.
|
|
; ENTER WITH: ACKD0=IFN from QUASAR Visit file, DFN=Patient#
|
|
;
|
|
D DEM^VADPT S ACKQRAW=$G(^ACK(509850.6,ACKD0,4)),ACK0=^(0),ACK2=^(2) K ACKC
|
|
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
|
|
S ACKDIV=$P(^ACK(509850.6,ACKD0,5),U,1)
|
|
S ACKDSTAT=$$GET1^DIQ(40.8,ACKDIV,1)
|
|
I ACKDIV'="" S ACKDIV=$$GET1^DIQ(40.8,ACKDIV,.01)
|
|
S ACKC(4)="DIVISION: "_$S($D(ACKDIV):ACKDIV,1:"No Division on file for Visit")
|
|
S ACKC(5)="STATION NUMBER: "_$S($D(ACKDSTAT):ACKDSTAT,1:"No station Number set up for Division")
|
|
;
|
|
;
|
|
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)=" "
|
|
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)=" "
|
|
F102 S ACKCNT=ACKCNT+1,ACKC(ACKCNT)="PHYSICAL EXAMINATION (OBJECTIVE FINDINGS):",ACKCNT=ACKCNT+1
|
|
S X="R500: ^R1000: ^R2000: ^R3000: ^R4000: ^R AVG: ^L500: ^L1000: ^L2000: ^L3000: ^L4000: ^L AVG: "
|
|
S ACKC(ACKCNT)="Pure Tone Results:",ACKCNT=ACKCNT+1
|
|
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
|
|
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
|
|
S ACKC(ACKCNT)="W22 R: "_$$J($P(ACKQRAW,U,15))_" W22 L: "_$$J($P(ACKQRAW,U,16)),ACKCNT=ACKCNT+1,ACKC(ACKCNT)=" "
|
|
I $O(^ACK(509850.6,ACKD0,102,0)) S ACKFLD=102 D FLD S ACKCNT=ACKCNT+1,ACKC(ACKCNT)=" "
|
|
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)=" "
|
|
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)=" "
|
|
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)=" "
|
|
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)
|
|
Q
|
|
;
|
|
;
|
|
FLD ; Build TMP array for audiometric fields.
|
|
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)
|
|
Q
|
|
;
|
|
J(X) ; JUSTIFY PROPERLY
|
|
Q $S(X="":"",1:$J(X,3,0))
|
|
;
|
|
CP ; Select any C&P clinic visit.
|
|
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)
|
|
Q
|
|
;
|
|
PULL2 ; Pulls QUASAR data into ACKC array to display audiometric fields.
|
|
; Called from New Visit function.
|
|
;
|
|
; ENTER WITH: ACKD0=IFN from QUASAR Visit file, DFN=Patient#
|
|
;
|
|
D DEM^VADPT S ACKQRAW=$G(^ACK(509850.6,ACKD0,4)),ACK0=^(0),ACK2=^(2) K ACKC
|
|
S X="R500: ^R1000: ^R2000: ^R3000: ^R4000: ^R AVG: ^L500: ^L1000: ^L2000: ^L3000: ^L4000: ^L AVG: "
|
|
S ACKC(1)="PURE TONE RESULTS:"
|
|
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
|
|
S ACKC(8)="SPEECH RECOGNITION SCORES:",ACKC(9)="CNC R: "_$$J($P(ACKQRAW,U,13))_" CNC L: "_$$J($P(ACKQRAW,U,14))
|
|
S ACKC(10)="W22 R: "_$$J($P(ACKQRAW,U,15))_" W22 L: "_$$J($P(ACKQRAW,U,16)),ACKC(11)=" "
|
|
Q
|
|
;
|