67 lines
3.0 KiB
Mathematica
67 lines
3.0 KiB
Mathematica
|
ACKQCPL ;AUG/JLTP BIR/PTD HCIOFO/BH-Lookup for C&P Exams Awaiting Adequation ; 04/22/96 14:16
|
||
|
|
;;3.0;QUASAR;;Feb 11, 2000
|
||
|
|
;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
|
||
|
|
;
|
||
|
|
BUILD ; Build array of exams user can adequate in ^TMP(.
|
||
|
|
N ACK5,ACKSTN,ACKDIV,ACKSTAT,ACKDUZ
|
||
|
|
S ACKDUZ=$$PROVCHK^ACKQASU4(DUZ) S:ACKDUZ="" ACKDUZ=" "
|
||
|
|
S ACKSUPER=$P($G(^ACK(509850.3,ACKDUZ,0)),U,6)
|
||
|
|
K ^TMP("ACKQCPL",$J) S (ACKWT,ACKCNT)=0 F S ACKWT=$O(^ACK(509850.6,"AWAIT",2,ACKWT)) Q:'ACKWT I ACKSUPER!($D(^ACK(509850.6,"ST",ACKDUZ,ACKWT))) D
|
||
|
|
.S ACKZNODE=$G(^ACK(509850.6,ACKWT,0))
|
||
|
|
.I $P(ACKZNODE,U,8),$$EN1^DVBCTRN($P(ACKZNODE,U,2),"AUDIO",$P(ACKZNODE,U,8))>0 D
|
||
|
|
..S ACK5=$G(^ACK(509850.6,ACKWT,5))
|
||
|
|
..S ACKCNT=ACKCNT+1,ACKDFN=$G(^DPT(+$P(ACKZNODE,U,2),0))
|
||
|
|
..S Y=+ACKZNODE S:Y["." Y=$P(Y,".",1)
|
||
|
|
..I $D(ACK5) S Y=Y_$P(ACK5,U,8) ; Concatenate App. time to Visit Date
|
||
|
|
..X ^DD("DD") S Y=$P(Y,":",1,2),ACKVDT=Y,ACKSP=" "
|
||
|
|
..S ACKSSN=$E($P(ACKDFN,U,9),1,3)_"-"_$E($P(ACKDFN,U,9),4,5)_"-"_$E($P(ACKDFN,U,9),6,9)
|
||
|
|
..S ACKVDIV=$P(ACK5,U,1) ; Get division code
|
||
|
|
..S ACKSTN=$$GET1^DIQ(40.8,ACKVDIV,1) ; Get Division Station Number
|
||
|
|
..S ^TMP("ACKQCPL",$J,ACKCNT,ACKWT)=$E(ACKVDT_ACKSP,1,18)_$P(ACKDFN,U)_$E(ACKSP,$L($P(ACKDFN,U))+1,37)_ACKSSN_" "_$E(ACKSTN_ACKSP,1,7)
|
||
|
|
; If no exams
|
||
|
|
I '$O(^TMP("ACKQCPL",$J,0)) D G EXIT
|
||
|
|
. W !,$C(7)
|
||
|
|
. W "No C&P exams awaiting adequation now." S DIRUT=1
|
||
|
|
;
|
||
|
|
; If only one exam
|
||
|
|
I ACKCNT=1 D G:$D(DIRUT) EXIT G SET
|
||
|
|
. W !,"There is only one C&P exam awaiting adequation.",!! D HEAD(0)
|
||
|
|
. W !,^TMP("ACKQCPL",$J,1,$O(^TMP("ACKQCPL",$J,1,0))),!!!
|
||
|
|
. ;
|
||
|
|
. S ACKVIEN=$O(^TMP("ACKQCPL",$J,1,0))
|
||
|
|
. W "Press RETURN to process this exam.",!
|
||
|
|
. S ACKNUM=1 S DIR(0)="E" D ^DIR K DIR Q:$D(DIRUT)
|
||
|
|
. ; Check this entry is not locked
|
||
|
|
. L +^ACK(509850.6,ACKVIEN):2 E W !!,"This record is locked by another process - Please try again later.",!! S DIRUT=1 Q
|
||
|
|
;
|
||
|
|
;
|
||
|
|
CHOICE ; Display list of C&P exams to adequate.
|
||
|
|
D HEAD(1)
|
||
|
|
S ACKNUM=0 F S ACKNUM=$O(^TMP("ACKQCPL",$J,ACKNUM)) Q:'ACKNUM!($D(DIRUT)) D
|
||
|
|
.I $Y>(IOSL-5) D PAUSE^ACKQUTL Q:$D(DIRUT) W @IOF D HEAD(1)
|
||
|
|
.W !,$J(ACKNUM,3),". ",^TMP("ACKQCPL",$J,ACKNUM,$O(^TMP("ACKQCPL",$J,ACKNUM,0)))
|
||
|
|
; Select one
|
||
|
|
I $D(DIRUT) G EXIT
|
||
|
|
CHOICE1 S DIR(0)="NA^1:"_ACKCNT,DIR("A")="Select, by number, the exam you wish to adequate: ",DIR("?")="Choose a number from the list of exams"
|
||
|
|
W ! D ^DIR K DIR I $D(DIRUT) G EXIT
|
||
|
|
S ACKNUM=Y
|
||
|
|
;
|
||
|
|
SET ; Set ACKD0, ACKSFT, and DFN before exit and check for locking
|
||
|
|
S ACKD0=$O(^TMP("ACKQCPL",$J,ACKNUM,0))
|
||
|
|
;
|
||
|
|
; Check this entry is not locked
|
||
|
|
L +^ACK(509850.6,ACKD0):2 E W !!,"This record is locked by another process - Please try again later.",!! K ACKD0 G CHOICE1
|
||
|
|
;
|
||
|
|
S DFN=+$P(^ACK(509850.6,ACKD0,0),U,2),ACKSFT=$P(^ACK(509850.6,ACKD0,0),U,8)
|
||
|
|
;
|
||
|
|
EXIT ; Kill variables and return to calling routine.
|
||
|
|
K ACKCNT,ACKDFN,ACKNUM,ACKSP,ACKSSN,ACKSUPER,ACKVDT,ACKWT,ACKZNODE
|
||
|
|
K DIR,X,Y,^TMP("ACKQCPL",$J),ACKVIEN
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
HEAD(ACKX) ; Draws Heading on screen
|
||
|
|
W ! W:ACKX " " W "Visit Date/Time Name SSN Stn. #",!
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
;
|