89 lines
3.5 KiB
Mathematica
89 lines
3.5 KiB
Mathematica
QAOEDT1 ;HISC/DAD-QUICK EXCEPTION EDIT ;7/26/93 13:09
|
|
;;3.0;Occurrence Screen;;09/14/1993
|
|
D HOME^%ZIS
|
|
S QAOSCLIN=$O(^QA(741.2,"C",1,0)),QAOSFIND=$O(^QA(741.6,"B",3,0))
|
|
S QAOSACTN=$O(^QA(741.7,"B",1,0)) D NOW^%DTC S QAOSDT=X
|
|
ASKCLIN ;
|
|
K DIC S DIC="^VA(200,",DIC(0)="AEQ"
|
|
S DIC("A")="Select CLINICAL REVIEWER: "
|
|
S DIC("S")="I $D(^XUSEC(""QAOSCLIN"",+Y))",D="AK.QAOSCLIN"
|
|
W ! D IX^DIC G:Y'>0 EXIT S QAOSREVR=+Y
|
|
S QALIMIT="I $P(^(0),""^"",11)'>0",QAOSPROG="DFN^QAOEDT1" D EN2^QAOEDT
|
|
G ASKCLIN
|
|
DFN ;
|
|
S QAOSQUIT=0,QAOSWHAT="REVIEWED" D ENDISP^QAOUTL0
|
|
I $O(^QA(741,QAOSD0,"REVR",0)) D Q
|
|
. W *7,!!?15,"*** REVIEWS ALREADY EXIST FOR THIS OCCURRENCE ***"
|
|
. W !?2,"*** Use the 'Clinical, Peer, Manager Review' option to edit exceptions ***",!,*7
|
|
. K DIR S DIR(0)="E" D ^DIR S QAOSQUIT=$S(Y'>0:1,1:0)
|
|
. Q
|
|
D EXCEPT Q:QAOSQUIT
|
|
ASKOK ;
|
|
G:$O(^TMP($J,"QAOS EXCEPTION",0)) DOIT
|
|
W !!?5,"Mark this record as an exception (Y/N) "
|
|
S %=2 D YN^DICN I '% W !!?10,"Please answer Y(es) or N(o)" G ASKOK
|
|
S:%=-1 QAOSQUIT=1 Q:%'=1
|
|
DOIT ;
|
|
W !!,"Entering Clinical Review Findings as Exception to Criteria..."
|
|
S ^QA(741,QAOSD0,"REVR",0)="^741.01IPA^1^1"
|
|
S ^QA(741,QAOSD0,"REVR",1,0)=QAOSCLIN_"^"_QAOSREVR_"^"_QAOSDT_"^^"_QAOSFIND
|
|
S ^QA(741,QAOSD0,"REVR",1,2,0)="^741.15PA^1^1"
|
|
S ^QA(741,QAOSD0,"REVR",1,2,1,0)=QAOSACTN
|
|
I QAOSQUIT'>0 D
|
|
. S QAOS=0
|
|
. F QAOS1=0:0 S QAOS1=$O(^TMP($J,"QAOS EXCEPTION",QAOS1)) Q:QAOS1'>0 D
|
|
.. S QAOS=QAOS+1,^QA(741,QAOSD0,"REVR",1,1,QAOS,0)=QAOS1
|
|
.. Q
|
|
. S ^QA(741,QAOSD0,"REVR",1,1,0)="^741.12PA^"_QAOS_"^"_QAOS
|
|
. Q
|
|
S DIK="^QA(741,",DA=QAOSD0 D IX1^DIK K DIK
|
|
S QAUDIT("FILE")="741^27",QAUDIT("DA")=QAOSD0,QAUDIT("ACTION")="e"
|
|
S QAUDIT("COMMENT")="QUICK EXCEPTION EDIT" D ^QAQAUDIT
|
|
W "Finished"
|
|
W !,"Entering Final Disposition..."
|
|
K DR S DIE="^QA(741,",DR="11///1;14///TODAY;16///`"_QAOSCLIN
|
|
S (D0,DA)=QAOSD0 D ^DIE
|
|
S QAUDIT("FILE")="741^27",QAUDIT("DA")=QAOSD0,QAUDIT("ACTION")="c"
|
|
S QAUDIT("COMMENT")="CLOSE A RECORD" D ^QAQAUDIT
|
|
W "Finished"
|
|
Q
|
|
EXIT ;
|
|
K D,D0,DA,DIC,DIE,DIK,DIR,DR,QA,QAOS,QAOS1,QAOSACTN,QAOSCLIN,QAOSD0,QAQA
|
|
K QAOSDSEL,QAOSDT,QAOSFIND,QAOSLINE,QAOSNUM,QAOSQUIT,QAOSREVR,QAOSSCRN
|
|
K QAOSWHAT,QAUDIT,X,Y,QALIMIT,QAOSONE,QAOSPROG,^TMP($J,"QAOS EXCEPTION")
|
|
Q
|
|
EXCEPT ; *** SELECT A GROUP OF EXCEPTIONS
|
|
; *** RETURNS ^TMP($J,"QAOS EXCEPTION",EXCEPTION IEN)=""
|
|
; *** RETURNS QAOSQUIT = $S('^' OUT:1,TIME OUT:1,1:0)
|
|
S QAOSQUIT=0,QAOSNUM=1,QAOSSCRN=+$G(^QA(741,QAOSD0,"SCRN"))
|
|
K ^TMP($J,"QAOS EXCEPTION")
|
|
ASKEXC ;
|
|
W !!,$S(QAOSNUM>1:"Another one",1:"Select EXCEPTION")_": "
|
|
R X:DTIME S:('$T)!($E(X)="^") QAOSQUIT=1 Q:X=""!QAOSQUIT
|
|
I X?1"?".E D
|
|
. W !!?5,"Select an exception name or number, to deselect an item"
|
|
. W !?5,"type a minus sign (-) in front of it, e.g. -EXCEPTION.",!
|
|
. D:$O(^TMP($J,"QAOS EXCEPTION",0)) SHOW
|
|
. Q
|
|
K DIC S DIC="^QA(741.5,",DIC(0)="EMNQ"
|
|
S DIC("S")="S QA=^(0) I $P(QA,""^"",2)=QAOSSCRN,$P(QA,""^"",4)'>0"
|
|
S QAOSDSEL=$S(X?1"-".E:1,1:0) S:QAOSDSEL X=$E(X,2,$L(X))
|
|
D ^DIC K DIC G:+Y'>0 ASKEXC
|
|
I 'QAOSDSEL,'$D(^TMP($J,"QAOS EXCEPTION",+Y)) D
|
|
. S ^TMP($J,"QAOS EXCEPTION",+Y)="",QAOSNUM=QAOSNUM+1
|
|
. Q
|
|
I QAOSDSEL,$D(^TMP($J,"QAOS EXCEPTION",+Y)) D
|
|
. K ^TMP($J,"QAOS EXCEPTION",+Y) S QAOSNUM=QAOSNUM-$S(QAOSNUM>0:1,1:0)
|
|
. Q
|
|
G ASKEXC
|
|
SHOW ;
|
|
N X S QAOSLINE=$Y,QAOS1="" W !,"You have already selected:"
|
|
F QAOS1=0:0 S QAOS1=$O(^TMP($J,"QAOS EXCEPTION",QAOS1)) Q:QAOS1'>0!QAOSQUIT D
|
|
. S QAOS=$G(^QA(741.5,QAOS1,0))
|
|
. W !?3,$P(QAOS,"^",3)," ",$P(QAOS,"^") D:$Y>(IOSL+QAOSLINE-3)
|
|
.. K DIR S DIR(0)="E" D ^DIR S QAOSQUIT=$S(Y'>0:1,1:0),QAOSLINE=$Y
|
|
.. Q
|
|
. Q
|
|
W ! S QAOSQUIT=0
|
|
Q
|