| 1 | ACKQCPL ;AUG/JLTP BIR/PTD HCIOFO/BH-Lookup for C&P Exams Awaiting Adequation ; 04/22/96 14:16
|
|---|
| 2 | ;;3.0;QUASAR;;Feb 11, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | BUILD ; Build array of exams user can adequate in ^TMP(.
|
|---|
| 6 | N ACK5,ACKSTN,ACKDIV,ACKSTAT,ACKDUZ
|
|---|
| 7 | S ACKDUZ=$$PROVCHK^ACKQASU4(DUZ) S:ACKDUZ="" ACKDUZ=" "
|
|---|
| 8 | S ACKSUPER=$P($G(^ACK(509850.3,ACKDUZ,0)),U,6)
|
|---|
| 9 | 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
|
|---|
| 10 | .S ACKZNODE=$G(^ACK(509850.6,ACKWT,0))
|
|---|
| 11 | .I $P(ACKZNODE,U,8),$$EN1^DVBCTRN($P(ACKZNODE,U,2),"AUDIO",$P(ACKZNODE,U,8))>0 D
|
|---|
| 12 | ..S ACK5=$G(^ACK(509850.6,ACKWT,5))
|
|---|
| 13 | ..S ACKCNT=ACKCNT+1,ACKDFN=$G(^DPT(+$P(ACKZNODE,U,2),0))
|
|---|
| 14 | ..S Y=+ACKZNODE S:Y["." Y=$P(Y,".",1)
|
|---|
| 15 | ..I $D(ACK5) S Y=Y_$P(ACK5,U,8) ; Concatenate App. time to Visit Date
|
|---|
| 16 | ..X ^DD("DD") S Y=$P(Y,":",1,2),ACKVDT=Y,ACKSP=" "
|
|---|
| 17 | ..S ACKSSN=$E($P(ACKDFN,U,9),1,3)_"-"_$E($P(ACKDFN,U,9),4,5)_"-"_$E($P(ACKDFN,U,9),6,9)
|
|---|
| 18 | ..S ACKVDIV=$P(ACK5,U,1) ; Get division code
|
|---|
| 19 | ..S ACKSTN=$$GET1^DIQ(40.8,ACKVDIV,1) ; Get Division Station Number
|
|---|
| 20 | ..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)
|
|---|
| 21 | ; If no exams
|
|---|
| 22 | I '$O(^TMP("ACKQCPL",$J,0)) D G EXIT
|
|---|
| 23 | . W !,$C(7)
|
|---|
| 24 | . W "No C&P exams awaiting adequation now." S DIRUT=1
|
|---|
| 25 | ;
|
|---|
| 26 | ; If only one exam
|
|---|
| 27 | I ACKCNT=1 D G:$D(DIRUT) EXIT G SET
|
|---|
| 28 | . W !,"There is only one C&P exam awaiting adequation.",!! D HEAD(0)
|
|---|
| 29 | . W !,^TMP("ACKQCPL",$J,1,$O(^TMP("ACKQCPL",$J,1,0))),!!!
|
|---|
| 30 | . ;
|
|---|
| 31 | . S ACKVIEN=$O(^TMP("ACKQCPL",$J,1,0))
|
|---|
| 32 | . W "Press RETURN to process this exam.",!
|
|---|
| 33 | . S ACKNUM=1 S DIR(0)="E" D ^DIR K DIR Q:$D(DIRUT)
|
|---|
| 34 | . ; Check this entry is not locked
|
|---|
| 35 | . L +^ACK(509850.6,ACKVIEN):2 E W !!,"This record is locked by another process - Please try again later.",!! S DIRUT=1 Q
|
|---|
| 36 | ;
|
|---|
| 37 | ;
|
|---|
| 38 | CHOICE ; Display list of C&P exams to adequate.
|
|---|
| 39 | D HEAD(1)
|
|---|
| 40 | S ACKNUM=0 F S ACKNUM=$O(^TMP("ACKQCPL",$J,ACKNUM)) Q:'ACKNUM!($D(DIRUT)) D
|
|---|
| 41 | .I $Y>(IOSL-5) D PAUSE^ACKQUTL Q:$D(DIRUT) W @IOF D HEAD(1)
|
|---|
| 42 | .W !,$J(ACKNUM,3),". ",^TMP("ACKQCPL",$J,ACKNUM,$O(^TMP("ACKQCPL",$J,ACKNUM,0)))
|
|---|
| 43 | ; Select one
|
|---|
| 44 | I $D(DIRUT) G EXIT
|
|---|
| 45 | 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"
|
|---|
| 46 | W ! D ^DIR K DIR I $D(DIRUT) G EXIT
|
|---|
| 47 | S ACKNUM=Y
|
|---|
| 48 | ;
|
|---|
| 49 | SET ; Set ACKD0, ACKSFT, and DFN before exit and check for locking
|
|---|
| 50 | S ACKD0=$O(^TMP("ACKQCPL",$J,ACKNUM,0))
|
|---|
| 51 | ;
|
|---|
| 52 | ; Check this entry is not locked
|
|---|
| 53 | L +^ACK(509850.6,ACKD0):2 E W !!,"This record is locked by another process - Please try again later.",!! K ACKD0 G CHOICE1
|
|---|
| 54 | ;
|
|---|
| 55 | S DFN=+$P(^ACK(509850.6,ACKD0,0),U,2),ACKSFT=$P(^ACK(509850.6,ACKD0,0),U,8)
|
|---|
| 56 | ;
|
|---|
| 57 | EXIT ; Kill variables and return to calling routine.
|
|---|
| 58 | K ACKCNT,ACKDFN,ACKNUM,ACKSP,ACKSSN,ACKSUPER,ACKVDT,ACKWT,ACKZNODE
|
|---|
| 59 | K DIR,X,Y,^TMP("ACKQCPL",$J),ACKVIEN
|
|---|
| 60 | Q
|
|---|
| 61 | ;
|
|---|
| 62 | HEAD(ACKX) ; Draws Heading on screen
|
|---|
| 63 | W ! W:ACKX " " W "Visit Date/Time Name SSN Stn. #",!
|
|---|
| 64 | Q
|
|---|
| 65 | ;
|
|---|
| 66 | ;
|
|---|
