| [613] | 1 | MCARDNJ2 ;WISC/TJK,JA-FUNCTION FOR DISPLAY ONLY ;8/22/96 15:28
|
|---|
| 2 | ;;2.3;Medicine;;09/13/1996
|
|---|
| 3 | FUNC ;FUNCTION COMMANDS
|
|---|
| 4 | X DJCP W DJHIN X XY W "FUNCTIONS",DJLIN
|
|---|
| 5 | W !!," ^ -- Quit"
|
|---|
| 6 | W:$P(^MCAR(697.3,DJN,0),"^",3)]"" ?41,"U -- Up a page"
|
|---|
| 7 | W !," N -- New record"
|
|---|
| 8 | W:$P(^MCAR(697.3,DJN,0),"^",5)]"" ?41,"D -- Down a page"
|
|---|
| 9 | LST X DJCL W "FUNCTION: ",$S($P(DJJ,U,4)="":"N",1:"D"),"//" R X:DTIME S:'$T X="^" S:X=""!(X["D") X="D" G MOD:X?1"^"1N.N G Q:X["N"&(DJP=0) Q:X["N"&(DJP=1)
|
|---|
| 10 | LS1 G:X?1"^" OUT I X["D"&($P(DJJ,U,4)]"")&($D(DJDN)) D SAVE S DJN=$P(DJJ,U,4) S DJN=$O(^MCAR(697.3,"B",DJN,0)) S:DJN="" DJN=-1 S DJFF=0 D N^MCARDPL Q:$D(DJY) S (DA,W(V))=DJDN D ^MCARD1 G EN2^MCARDNJ
|
|---|
| 11 | I X["D"&($P(DJJ,U,4)="") S:$P(DJJ,U,2)'="" DJFF=0 G Q
|
|---|
| 12 | G:X["U" PREV
|
|---|
| 13 | G LST
|
|---|
| 14 | MOD I $D(DJJ($P(X,U,2))) S V=$P(X,"^",2) S:DJ4["M"&($D(DJDIS)) DJSW1=1,DJDIS=0 S V=V-.001 G NXT
|
|---|
| 15 | PREV G LST:$P(DJJ,U,2)="" S DJN=$P(DJJ,U,2) S:DJN'=+DJN DJN=$O(^MCAR(697.3,"B",DJN,0)) S:DJN="" DJN=-1 S DJFF=0 D REST D N^MCARDPL G NXT
|
|---|
| 16 | Q I $P(^MCAR(697.3,DJN,0),U,3)'="" F DJK=0:0 S (DJDPL,DJNM)=$P(^MCAR(697.3,DJN,0),U,3),DJN=$O(^MCAR(697.3,"B",DJNM,0)) S:DJN="" DJN=-1 Q:$P(^MCAR(697.3,DJN,0),U,3)=""
|
|---|
| 17 | K V,DJ0,DJAT,DJDN,DJ3,DJ4,DJQ I '$D(DJW1) D ^MCARDPL G EN2^MCARDNJ
|
|---|
| 18 | OUT K DJSV,DJ0,DJAT,DJK,DJDN,DJ3,V,DJJ,DJQ,DIC,DJDD,DX,DY,DJSM,DJDIC,DJKEY S DJFF=0 Q
|
|---|
| 19 | KILL K DB,DC,DE,DG,DH,DI,DK,DL,DM,DP,DR,DW Q
|
|---|
| 20 | SAVE S %X="V(",%Y="^TMP($J,""DJ"",DJN," D %XY^%RCR K V Q
|
|---|
| 21 | REST K V S %X="^TMP($J,""DJ"",DJN,",%Y="V(" D %XY^%RCR Q
|
|---|
| 22 | NXT G NXT^MCARDNJ
|
|---|
| 23 | ;CALLED BY MCARDNJ
|
|---|
| 24 | COMPUTE D COMPUTE1 G NXT
|
|---|
| 25 | COMPUTE1 D:$D(DA(1)) SET X $P(^DD(DJDD,$P(DJJ(V),U,3),0),U,5,99) D BLANK^MCARD1 S V(V)=X D:$D(DA(1)) RESET S @$P(DJJ(V),U,2) X XY S $P(DJDB," ",DJJ(V))=" " W DJDB X XY W:X DJHIN,X K DJDB X XY
|
|---|
| 26 | Q
|
|---|
| 27 | SET S DJMD0=D0,DJMD1=D1,D0=DA(1),D1=DA Q
|
|---|
| 28 | RESET S D0=DJMD0,D1=DJMD1 K DJMD0,DJMD1 Q
|
|---|
| 29 | B S DJDB="" S:(DJJ(V)-$L(V(V))) $P(DJDB," ",DJJ(V)-$L(V(V)))=" " Q
|
|---|
| 30 | D S $P(DJDB,".",DJJ(V))="."
|
|---|
| 31 | Q
|
|---|
| 32 | ;
|
|---|
| 33 | Z ; input reader - invoked by R^MCARDNJ
|
|---|
| 34 | D DCS^MCARDNQ
|
|---|
| 35 | ;
|
|---|
| 36 | ; if this is a pointer multiple, do some cleanup of the system table
|
|---|
| 37 | S X=$P(DJJ(V),"^",4)
|
|---|
| 38 | IF X["P",X["M" D ; a pointer multiple
|
|---|
| 39 | . K DIC("S") ;,DA
|
|---|
| 40 | . S DG=12,DIC(0)="EQZML"
|
|---|
| 41 | . S DIC("V")=DIC_D0_","_(+$P(DJ0,"^",4))_"," ; suspect that this is the critical variable
|
|---|
| 42 | . S DJXX="?",Y=-1
|
|---|
| 43 | . Q
|
|---|
| 44 | ;END IF
|
|---|
| 45 | ;
|
|---|
| 46 | ; get the input
|
|---|
| 47 | S X="",DJSM=0,DJLG=+DJJ(V)+1
|
|---|
| 48 | ;I DJLG<81 D
|
|---|
| 49 | ;. R X#DJLG:DTIME S DJZ=$T
|
|---|
| 50 | ;E ; next line used to be concatenated with this one
|
|---|
| 51 | S X=$$RESPONSE^MCARDSE("",DJLG-1,DX,DY),DJZ=$P(X,"~",2),X=$P(X,"~",1)
|
|---|
| 52 | S:'DJZ X="^" S:X="" DJSM=1 K:X="" DIC("S")
|
|---|
| 53 | I $L(X)>(DJLG-1) W @IOBS," ",*7 X XY S:'$D(V(V)) V(V)="" D B:V(V)'="",D:V(V)="",M K DJDB X XY G Z
|
|---|
| 54 | I X?1"^".E!(X?1"?".E) S:'$D(V(V)) V(V)="" D B:V(V)'="",D:V(V)="" X XY W DJHIN X XY D M W DJLIN K DJDB X XY Q
|
|---|
| 55 | Q
|
|---|
| 56 | N R !,"Press <RETURN> to Continue",DJX:DTIME S DJSV=V D N^MCARDPL S V=DJSV Q
|
|---|
| 57 | HELP W !!,*7,"Answer 'YES' or 'NO'. As a general rule, you should repaint the screen if the screen has been 'pushed up' by the word processing field"
|
|---|
| 58 | G N
|
|---|
| 59 | M ;W V(V) W:$D(DJDB) DJDB ; ;8/31/92 14:18
|
|---|
| 60 | S DJDB=V(V)_$G(DJDB)
|
|---|
| 61 | I $L(DJDB)<80 W DJDB
|
|---|
| 62 | E W $E(DJDB,1,80-DX),!,$E(DJDB,80-DX+1,$L(DJDB))
|
|---|
| 63 | Q
|
|---|
