| [613] | 1 | MCRH2 ;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
|
|---|
| 4 | SET 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
|
|---|
| 11 | KILL 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
|
|---|
| 18 | PRINT ;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
|
|---|
| 24 | TEXTHELP ; 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
|
|---|
| 28 | TEXT(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.
|
|---|
