MCRH2.m

MCRH2 ;WISC/TJK-RHEUMATOLOGY ICD CODE UPDATE FOR QMAN ;7/3/96  09:14

 ;;2.3;Medicine;;09/13/1996

 ;CALLED FROM DIAGNOSIS FIELD OF RHEUMATOLOGY FILE

SET N ICD

 S ICD=$G(^MCAR(697.5,X,2,1,0)) Q:'ICD

 S:'$D(^MCAR(701,DA(1),"ICD",0)) ^(0)="^701.01P^^"

 S $P(^MCAR(701,DA(1),"ICD",0),U,3)=DA,$P(^(0),U,4)=$P(^(0),U,4)+1

 S ^MCAR(701,DA(1),"ICD",DA,0)=ICD

 S ^MCAR(701,DA(1),"ICD","B",ICD,DA)=""

 Q

KILL N ICD,I,I1

 S ICD=$P($G(^MCAR(701,DA(1),"ICD",DA,0)),U) Q:'ICD

 K ^MCAR(701,DA(1),"ICD",DA),^MCAR(701,DA(1),"ICD","B",ICD,DA)

 S $P(^MCAR(701,DA(1),"ICD",0),U,4)=$P(^MCAR(701,DA(1),"ICD",0),U,4)-1

 S I=0 F  S I=$O(^MCAR(701,DA(1),"ICD",I)) Q:I'?1N.N  S I1=I

 S $P(^MCAR(701,DA(1),"ICD",0),U,3)=$S($G(I1):I1,1:"")

 Q

PRINT ;PRINTS OUT ICD CODE ON DIAGNOSIS PRINT-CALLED BY PRINT TEMPLATE

 N ICD

 S ICD=$P($G(^MCAR(701,D0,"ICD",D1,0)),U)

 S:ICD'="" ICD=$P(^ICD9(ICD,0),U)

 W ?68,ICD

 Q

TEXTHELP ; Display help text from the Data dictionary at the beginging of ever field for RHEUMATOLOGY

 Q

 N LM,RM,HELP S LM=80,RM=0,HELP=$G(^DD(DJDD,DJAT,3)) D TEXT(HELP,LM,RM)

 Q

TEXT(STRING,LM,RM) ;Word warps a string of text and prints it out

 ;

 ;STRING = The text to display on the screen

 ;    LM = The left margin

 ;    RM = the right margin

 N SPACE,LINE,WORD,TEXT,LENGTH,COUNT,TEMP

 S RM=+RM,LM=+LM

 I (LM>80)!(LM=0) S LM=80

 I LM<RM S RM=TEMP,RM=LM,LM=TEMP

 S STRING=STRING_" <*>" ; set up a stopper for word spitter this will allow double spacing between sentences.

 I $D(DJCP) X DJCP ; if using the screen handler move to the bottom

 F SPACE=1:1 S WORD(SPACE)=$P(STRING," ",SPACE) Q:WORD(SPACE)="<*>"

 K WORD(SPACE) S TEXT="",SPACE=SPACE-1

 F COUNT=1:1:SPACE D

 .S TEMP=TEXT_WORD(COUNT)_" "

 .I $L(TEMP)>(LM-RM) W !,?RM,TEXT S TEXT=WORD(COUNT)_" "

 .E  S TEXT=TEMP

 .Q  ; end for

 W !,?RM,TEXT ; Write the text at the right margin

 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. 

MCRH2     ;WISC/TJK-RHEUMATOLOGY ICD CODE UPDATE FOR QMAN ;7/3/96  09:14

 +1       ;;2.3;Medicine;;09/13/1996

 +2       ;CALLED FROM DIAGNOSIS FIELD OF RHEUMATOLOGY FILE

SET        NEW ICD

 +1        SET ICD=$GET(^MCAR(697.5,X,2,1,0))

           IF 'ICD

               QUIT 

 +2        IF '$DATA(^MCAR(701,DA(1),"ICD",0))

               SET ^(0)="^701.01P^^"

 +3        SET $PIECE(^MCAR(701,DA(1),"ICD",0),U,3)=DA

           SET $PIECE(^(0),U,4)=$PIECE(^(0),U,4)+1

 +4        SET ^MCAR(701,DA(1),"ICD",DA,0)=ICD

 +5        SET ^MCAR(701,DA(1),"ICD","B",ICD,DA)=""

 +6        QUIT 

KILL       NEW ICD,I,I1

 +1        SET ICD=$PIECE($GET(^MCAR(701,DA(1),"ICD",DA,0)),U)

           IF 'ICD

               QUIT 

 +2        KILL ^MCAR(701,DA(1),"ICD",DA),^MCAR(701,DA(1),"ICD","B",ICD,DA)

 +3        SET $PIECE(^MCAR(701,DA(1),"ICD",0),U,4)=$PIECE(^MCAR(701,DA(1),"ICD",0),U,4)-1

 +4        SET I=0

           FOR 

               SET I=$ORDER(^MCAR(701,DA(1),"ICD",I))

               IF I'?1N.N

                   QUIT 

               SET I1=I

 +5        SET $PIECE(^MCAR(701,DA(1),"ICD",0),U,3)=$SELECT($GET(I1):I1,1:"")

 +6        QUIT 

PRINT     ;PRINTS OUT ICD CODE ON DIAGNOSIS PRINT-CALLED BY PRINT TEMPLATE

 +1        NEW ICD

 +2        SET ICD=$PIECE($GET(^MCAR(701,D0,"ICD",D1,0)),U)

 +3        IF ICD'=""

               SET ICD=$PIECE(^ICD9(ICD,0),U)

 +4        WRITE ?68,ICD

 +5        QUIT 

TEXTHELP  ; Display help text from the Data dictionary at the beginging of ever field for RHEUMATOLOGY

 +1        QUIT 

 +2        NEW LM,RM,HELP

           SET LM=80

           SET RM=0

           SET HELP=$GET(^DD(DJDD,DJAT,3))

           DO TEXT(HELP,LM,RM)

 +3        QUIT 

TEXT(STRING,LM,RM) ;Word warps a string of text and prints it out

 +1       ;

 +2       ;STRING = The text to display on the screen

 +3       ;    LM = The left margin

 +4       ;    RM = the right margin

 +5        NEW SPACE,LINE,WORD,TEXT,LENGTH,COUNT,TEMP

 +6        SET RM=+RM

           SET LM=+LM

 +7        IF (LM>80)!(LM=0)

               SET LM=80

 +8        IF LM<RM

               SET RM=TEMP

               SET RM=LM

               SET LM=TEMP

 +9       ; set up a stopper for word spitter this will allow double spacing between sentences.

           SET STRING=STRING_" <*>"

 +10      ; if using the screen handler move to the bottom

           IF $DATA(DJCP)

               XECUTE DJCP

 +11       FOR SPACE=1:1

               SET WORD(SPACE)=$PIECE(STRING," ",SPACE)

               IF WORD(SPACE)="<*>"

                   QUIT 

 +12       KILL WORD(SPACE)

           SET TEXT=""

           SET SPACE=SPACE-1

 +13       FOR COUNT=1:1:SPACE

               Begin DoDot:1

 +14               SET TEMP=TEXT_WORD(COUNT)_" "

 +15               IF $LENGTH(TEMP)>(LM-RM)

                       WRITE !,?RM,TEXT

                       SET TEXT=WORD(COUNT)_" "

 +16              IF '$TEST

                       SET TEXT=TEMP

 +17      ; end for

                   QUIT 

               End DoDot:1

 +18      ; Write the text at the right margin

           WRITE !,?RM,TEXT

 +19      ;if using the screen handle routine move back to the field location. 

           IF $DATA(DJJ($GET(V)))

               IF $DATA(XY)

                   SET @$PIECE(DJJ(V),U,2)

                   XECUTE XY