38 lines
1.6 KiB
Mathematica
38 lines
1.6 KiB
Mathematica
QAOSERCR ;HISC/DAD-ENTER EDIT REASONS FOR CLINICAL REFERRAL ;5/4/93 15:37
|
|
;;3.0;Occurrence Screen;;09/14/1993
|
|
LOOP0 ;
|
|
S DIC="^QA(741.1,",DIC(0)="AEMQ",DIC("A")="Select SCREEN: "
|
|
S DIC("S")="I $P(^(0),""^"",4)=""L"""
|
|
W ! D ^DIC K DIC G:+Y=-1 EXIT S QAOSSCRN=+Y,QAOSSCRN(0)=$P(Y,"^",2)
|
|
D LOOP1 G LOOP0
|
|
EXIT ;
|
|
K %,%Y,DA,DIDEL,DLAYGO,DIE,DR,DIC,LINE,QA,QADA,QAOSQUIT,QAOSSCRN,X,Y
|
|
K %H,C,D0,DI,DQ,I,Y,Z
|
|
Q
|
|
LOOP1 ;
|
|
R !!,"Select REASON CODE: ",X:DTIME S:'$T X="^" Q:(X="")!(X["^")
|
|
I $E(X)="?" D HELP G LOOP1
|
|
S DIC="^QA(741.4,",DIC(0)="ELMQ",DIC("DR")=""
|
|
S DIC("S")="I $P(^QA(741.4,+Y,1),""^"",2)=QAOSSCRN",(DIDEL,DLAYGO)=741.4
|
|
D ^DIC K DIC("S") G:+Y=-1 LOOP1
|
|
S DIE=DIC,DR="2///`"_QAOSSCRN_";.01REASON CODE;3;1",DA=+Y D ^DIE
|
|
G LOOP1
|
|
HELP ;
|
|
G:X?2."?".E H0
|
|
W:$D(^DD(741.4,.01,3))#2 !!?1,^(3)
|
|
W !!," ANSWER WITH QA OCCURRENCE CLINICAL REFERRAL REASON CODE, OR"
|
|
W !," REASON - SHORT",!," YOU MAY ENTER A NEW QA OCCURRENCE CLINICAL REFERRAL, IF YOU WISH"
|
|
HASK W !," DO YOU WANT THE ENTIRE QA OCCURRENCE CLINICAL REFERRAL LIST"
|
|
S %=0 D YN^DICN Q:(%=-1)!(%=2)!((%=0)&(%Y=""))
|
|
I '% W !!?5,"Please answer Y(es) or N(o)",! G HASK
|
|
H0 ;
|
|
S LINE=$Y,QAOSQUIT=0 W !!,"CHOOSE FROM:"
|
|
F QA=0:0 S QA=$O(^QA(741.4,"AC",QAOSSCRN,QA)) Q:QA=""!QAOSQUIT F QADA=0:0 S QADA=$O(^QA(741.4,"AC",QAOSSCRN,QA,QADA)) Q:QADA'>0!QAOSQUIT D H1
|
|
W ! S QAOSQUIT=0
|
|
F QA=0:0 S QA=$O(^DD(741.4,.01,21,QA)) Q:QA'>0!QAOSQUIT W !?1,^DD(741.4,.01,21,QA,0) D H2
|
|
Q
|
|
H1 ;
|
|
I $D(^QA(741.4,QADA,0))#2 W !?3,$P(^(0),"^") W:$D(^(2))#2 " ",$P(^(2),"^")
|
|
H2 I $Y>(IOSL+LINE-3) S LINE=$Y K DIR S DIR(0)="E" D ^DIR K DIR S QAOSQUIT=$S(Y'>0:1,1:0)
|
|
Q
|