68 lines
3.1 KiB
Mathematica
68 lines
3.1 KiB
Mathematica
PSODEDT ;BHAM ISC/SAB - edit due answer sheet ; 06/03/92 17:26
|
|
;;7.0;OUTPATIENT PHARMACY;**2,268**;DEC 1997;Build 9
|
|
SEQNUM K DIC S DIC="^PS(50.0731,",DIC("A")="Select DUE ANSWER SEQUENCE NUMBER ('^S' to Search): ",DIC(0)="QEAM" D ^DIC K DIC
|
|
G:(X="^")!($D(DTOUT))!(X="") EXIT
|
|
S PSA=+Y
|
|
I (PSA<1)&($E(X,1,2)="^S") D SEARCH G:PSA<1 SEQNUM
|
|
I PSA<1 W " ??",$C(7) G SEQNUM
|
|
EDIT S DIE="^PS(50.0731,",(DA,PSODUEL)=PSA,DR=".01" L +^PS(50.0731,PSODUEL):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3) I '$T W !,"Entry is being edited by another user. Try Later!" G EXIT
|
|
D ^DIE L -^PS(50.0731,PSODUEL) K DIE,DA,DR,PSODUEL
|
|
G:$D(Y) EXIT
|
|
D:$D(^PS(50.0731,PSA,0)) DIE^PSODLKP
|
|
G PSODEDT
|
|
EXIT K ^TMP("PSOD",$J)
|
|
K DA,DIC,DIE,DIQ,DIR,DIROUT,DIRUT,DR,DTOUT,DUOUT,DX,DY,FLD,I,ID,IX,IXN
|
|
K IXS,N,PID,PSDPOP,PSA,PSCH,PSDIG,PSEED,PSFLAG,PSHI,PSHIT,PSIX,PSL,PSLEN
|
|
K PSLO,PSMARG,PSQ,PSQN,PSQNUM,PSQP,PSTXT,PSTYP,PSWRAP,X,Y
|
|
QUIT
|
|
;
|
|
SEARCH K DIR,DUOUT,DTOUT,PSCH,PSIX,PID,^TMP("PSOD",$J)
|
|
W !!!!!,"If you do not know the Sequence Number, you may search by any or all of the",!,"following fields: "
|
|
W !!?5,"QUESTIONNAIRE",!?5,"DRUG",!?5,"PROVIDER",!!?5,"Type '^' to exit.",!
|
|
S PSFLAG=0
|
|
F FLD=1,2,4 Q:$D(DTOUT)!$D(DUOUT) S DIR(0)="50.0731,"_FLD_"O" D ASK
|
|
Q:'PSFLAG
|
|
S IXS=""
|
|
F FLD=1,2,4 I $D(PSCH(FLD)),PSCH(FLD) S IXS=$S(FLD=1:"Q",FLD=2:"D",1:"P")_IXS
|
|
I $L(IXS)>1 S PSEED=$E(IXS) F N=0:0 S IX=PSEED D GETIXN S N=$O(^PS(50.0731,PSEED,PSCH(IXN),N)) Q:'N S PSHIT=1 D GETN I PSHIT S ^TMP("PSOD",$J,N)=""
|
|
I $L(IXS)=1 S IX=IXS D GETIXN F N=0:0 S N=$O(^PS(50.0731,IXS,PSCH(IXN),N)) Q:'N S ^TMP("PSOD",$J,N)=""
|
|
I '$D(^TMP("PSOD",$J)) W !!?5,"No Matches Found!!!",!! Q
|
|
I '$O(^TMP("PSOD",$J,$O(^TMP("PSOD",$J,0)))) S PSA=$O(^TMP("PSOD",$J,0)) W !! Q
|
|
S PSDPOP=0
|
|
CHOICES W !!?2,"CHOOSE FROM...",!!
|
|
S DIC="^PS(50.0731,",DR="1:9",DIQ="PID",DIQ(0)="E"
|
|
S PSL=$S($D(IOSL):IOSL-3,1:21),(DX,DY)=0 X ^%ZOSF("XY")
|
|
F N=0:0 S N=$O(^TMP("PSOD",$J,N)) Q:'N D DISPLAY Q:PSDPOP
|
|
K DIC,DIQ
|
|
S PSA=0
|
|
Q
|
|
ASK K DA
|
|
D ^DIR K DIR
|
|
S PSCH(FLD)=+Y,PSFLAG=PSFLAG+Y
|
|
Q
|
|
GETN F I=2:1:$L(IXS) S IX=$E(IXS,I) D GETIXN S PSHIT=PSHIT*$D(^PS(50.0731,IX,PSCH(IXN),N))
|
|
Q
|
|
GETIXN S IXN=$S(IX="Q":1,IX="D":2,1:4)
|
|
Q
|
|
DISPLAY I $Y,$Y>PSL S (DX,DY)=0 X ^%ZOSF("XY") S DIR(0)="E" D ^DIR W $C(13),$J("",45),$C(13) I 'Y S PSDPOP=1 Q
|
|
S (PSQNUM,DA)=N,PSQ=""
|
|
D EN^DIQ1
|
|
F ID=.01:0 S ID=$O(PID(50.0731,DA,ID)) Q:'ID S PSQ=PSQ_PID(50.0731,DA,ID,"E")_$S($L(PID(50.0731,DA,ID,"E")):"/",1:"")
|
|
D WRAP
|
|
Q
|
|
WRAP ;Enter here from PSODACT,PSODLKP,PSODEDT to format Question
|
|
;Needs PSQ=text, PSQNUM=question number
|
|
NEW I,K
|
|
S PSTXT=$P(PSQ,"^") W !,PSQNUM,"."
|
|
S PSWRAP=1,PSMARG=$S('$G(PSORM):80,$D(IOM):IOM,1:80)-5
|
|
W1 S:$L(PSTXT)<PSMARG PSWRAP(PSWRAP)=PSTXT I $L(PSTXT)'<PSMARG F I=PSMARG:-1:0 I $E(PSTXT,I)?1P S PSWRAP(PSWRAP)=$E(PSTXT,1,I),PSTXT=$E(PSTXT,I+1,999),PSWRAP=PSWRAP+1 G W1
|
|
F K=1:1:PSWRAP W ?($L(PSQNUM)+2),PSWRAP(K),!
|
|
Q
|
|
QUES2 I PSTYP=1 W !!,?5,"Enter Y for YES, N for NO, U for UNKNOWN."
|
|
I PSTYP=2 W !!,?5,"Enter a FREE TEXT answer from 1 to ",PSLEN," characters."
|
|
I PSTYP=3 W !!,?5,"Enter a number between ",PSLO," and ",PSHI,!,?5,"with a maximum of ",PSDIG," decimal digits."
|
|
W !?5,"Enter carriage return to bypass."
|
|
W !?5,"Enter '^' to exit."
|
|
D WRAP
|
|
Q
|