source: WorldVistAEHR/trunk/r/MEDICINE-MC/MCARDML.m@ 623

Last change on this file since 623 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.5 KB
Line 
1MCARDML ;WISC/TJK,JA-MULTIPLE STACK DRIVER ;6/29/92 14:37
2 ;;2.3;Medicine;;09/13/1996
3 ; invoked by paragraph R^MCARDNJ (user input handler)
4 K DJW2,DJK1 G EN3^MCARDNJ:X?1"^".N,TK^MCARDNJ:X=""!($E(X,1)="^") S:X="@" DJK1=1 S:X=" "!(X="@") X=V(V)
5 S DJST=DJST+1,^TMP($J,"DJST",DJST,"DA")=V(V,"DA")
6 S YMLH=$O(^MCAR(697.3,"B",$P(DJJ(V),U,6),0)) S:YMLH="" YMLH=-1
7 S ^TMP($J,"DJST",DJST,"SC")=YMLH,^TMP($J,"DJST",DJST-1,"LOC")=V,^TMP($J,"DJST",DJST,"DD")=V(V,"DD"),^TMP($J,"DJST",DJST,"GN")=V(V,"GN")
8 S ^TMP($J,"DJST",DJST,"FRSC")=DJN,^TMP($J,"DJST",DJST,"DIC")=^TMP($J,"DJST",DJST-1,"DIC")_^TMP($J,"DJST",DJST-1,"DA")_","_V(V,"GN")_","
9 S DJZ=DJST F DJK=1:1:DJST-1 S DJZ=DJZ-1,DA(DJZ)=^TMP($J,"DJST",DJK,"DA")
10 S DJNM=$P(^MCAR(697.3,^TMP($J,"DJST",DJST,"SC"),0),U,1),DIC=^TMP($J,"DJST",DJST,"DIC") S:$D(@(DIC_0_")"))=0 @(DIC_0_")")="^"_^TMP($J,"DJST",DJST,"DD")_"^^" K DJDN
11 S DIC(0)="EQZM" S:'$D(DJDIS) DIC(0)=DIC(0)_"L" X DJCP D ^MCARDC G D:$D(DJK1) I X["?" X DJCL S:DJ4["S" DJT=DJDD,DJDD=+DJ4,DJY=DJAT,DJAT=.01 D ^MCARDNQ:DJ4["S"!(DJ4["D") S:DJ4["S" DJDD=DJT,DJAT=DJY
12 I Y>0,$P(DJJ(V),U,7)=1 S V(V)=X D DISPLAY(V) G A
13 I $Y>23 R !,"Press <RETURN> to Continue",DJZ1:DTIME K DJZ1
14 I Y>0 D SAVE K V,DJMUL S DA=+Y,DJDN=+Y,^TMP($J,"DJST",DJST,"DA")=DA,@("D"_(DJST-1)_"="_DA) D ^MCARDPL S (W(V),V(V))=DJDN D ^MCARD1 S ^TMP($J,"DJST",DJST-1,"KEY")=V(DJKEY) D EN^MCARDNJ S DJW2=1
15A S DJN=^TMP($J,"DJST",DJST,"FRSC") S DJST=DJST-1 S DJNM=$P(^MCAR(697.3,DJN,0),"^",1),DIC=^TMP($J,"DJST",DJST,"DIC") S DJDN=^TMP($J,"DJST",DJST,"DA")
16 K DA S DJZ=DJST I $D(DJW2),DJST>1 F DJK=1:1:DJST-1 S DJZ=DJZ-1,DA(DJZ)=^TMP($J,"DJST",DJK,"DA")
17 S DA=DJDN ;DCB - Add May 4, 1994
18 I $D(DJW2),DJST>1 F DJK=0:1:DJST-2 S @("D"_DJK)=^TMP($J,"DJST",DJK+1,"DA")
19 I $D(DJW2) D REST S V=^TMP($J,"DJST",DJST,"LOC"),V(V)=^TMP($J,"DJST",DJST,"KEY") D ^MCARDPL K DJZ,DJW2 G N
20N S DJFF=0,V=^TMP($J,"DJST",DJST,"LOC") G TK^MCARDNJ
21SAVE S %X="V(",%Y="^TMP($J,""DJ"",DJN," D %XY^%RCR K V Q
22REST K MCDID S MCMASS=1
23 K V S %X="^TMP($J,""DJ"",DJN,",%Y="V(" D %XY^%RCR Q
24D G:Y<0 D1 I Y>0 X DJCL S DY=22,DX=0 X XY W DJEOP W !,"ARE YOU SURE YOU WANT TO DELETE: NO// ",*7 R DJX:DTIME
25 S DJX=$$UPPER^MCARDSE(DJX)
26 I DJX["?" W "ANSWER YES OR NO -- RETURN TO CONTINUE" R DJX:DTIME G D
27 G:DJX'["Y" D1 S DA=+Y,DR=".01///@" S DIE=DIC D ^DIE K DJK1 S V(V)="" G A
28D1 X DJCL W "NOTHING DELETED" G A
29DISPLAY(TEMP) ;Display the line
30 N HOLD,LEN,TEXT,SPACE S SPACE="",$P(SPACE," ",80)=" "
31 S TEXT=SPACE,HOLD=+DJJ(V)
32 S TEXT=$E(TEXT,1,HOLD)
33 S @$P(DJJ(V),U,2) X XY
34 W DJHIN,TEXT,DJLIN
35 Q
Note: See TracBrowser for help on using the repository browser.