source: FOIAVistA/tag/r/MEDICINE-MC/MCRH2.m@ 628

Last change on this file since 628 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version

File size: 1.9 KB
Line 
1MCRH2 ;WISC/TJK-RHEUMATOLOGY ICD CODE UPDATE FOR QMAN ;7/3/96 09:14
2 ;;2.3;Medicine;;09/13/1996
3 ;CALLED FROM DIAGNOSIS FIELD OF RHEUMATOLOGY FILE
4SET N ICD
5 S ICD=$G(^MCAR(697.5,X,2,1,0)) Q:'ICD
6 S:'$D(^MCAR(701,DA(1),"ICD",0)) ^(0)="^701.01P^^"
7 S $P(^MCAR(701,DA(1),"ICD",0),U,3)=DA,$P(^(0),U,4)=$P(^(0),U,4)+1
8 S ^MCAR(701,DA(1),"ICD",DA,0)=ICD
9 S ^MCAR(701,DA(1),"ICD","B",ICD,DA)=""
10 Q
11KILL N ICD,I,I1
12 S ICD=$P($G(^MCAR(701,DA(1),"ICD",DA,0)),U) Q:'ICD
13 K ^MCAR(701,DA(1),"ICD",DA),^MCAR(701,DA(1),"ICD","B",ICD,DA)
14 S $P(^MCAR(701,DA(1),"ICD",0),U,4)=$P(^MCAR(701,DA(1),"ICD",0),U,4)-1
15 S I=0 F S I=$O(^MCAR(701,DA(1),"ICD",I)) Q:I'?1N.N S I1=I
16 S $P(^MCAR(701,DA(1),"ICD",0),U,3)=$S($G(I1):I1,1:"")
17 Q
18PRINT ;PRINTS OUT ICD CODE ON DIAGNOSIS PRINT-CALLED BY PRINT TEMPLATE
19 N ICD
20 S ICD=$P($G(^MCAR(701,D0,"ICD",D1,0)),U)
21 S:ICD'="" ICD=$P(^ICD9(ICD,0),U)
22 W ?68,ICD
23 Q
24TEXTHELP ; Display help text from the Data dictionary at the beginging of ever field for RHEUMATOLOGY
25 Q
26 N LM,RM,HELP S LM=80,RM=0,HELP=$G(^DD(DJDD,DJAT,3)) D TEXT(HELP,LM,RM)
27 Q
28TEXT(STRING,LM,RM) ;Word warps a string of text and prints it out
29 ;
30 ;STRING = The text to display on the screen
31 ; LM = The left margin
32 ; RM = the right margin
33 N SPACE,LINE,WORD,TEXT,LENGTH,COUNT,TEMP
34 S RM=+RM,LM=+LM
35 I (LM>80)!(LM=0) S LM=80
36 I LM<RM S RM=TEMP,RM=LM,LM=TEMP
37 S STRING=STRING_" <*>" ; set up a stopper for word spitter this will allow double spacing between sentences.
38 I $D(DJCP) X DJCP ; if using the screen handler move to the bottom
39 F SPACE=1:1 S WORD(SPACE)=$P(STRING," ",SPACE) Q:WORD(SPACE)="<*>"
40 K WORD(SPACE) S TEXT="",SPACE=SPACE-1
41 F COUNT=1:1:SPACE D
42 .S TEMP=TEXT_WORD(COUNT)_" "
43 .I $L(TEMP)>(LM-RM) W !,?RM,TEXT S TEXT=WORD(COUNT)_" "
44 .E S TEXT=TEMP
45 .Q ; end for
46 W !,?RM,TEXT ; Write the text at the right margin
47 I $D(DJJ($G(V))),$D(XY) S @$P(DJJ(V),U,2) X XY ;if using the screen handle routine move back to the field location.
Note: See TracBrowser for help on using the repository browser.