MCRH3.m

MCRH3 ; HOIFO/NCA - RHEUMATOLOGY Patient Background Info ;7/3/96  09:13

 ;;2.3;Medicine;**35**;09/13/1996

 ; Reference IA #10088

EN1 ; Get the Medicine View File #697.3 entry.

 N MCARC,MCHDR,MCRHS,MCARR,MCLP,MCLP1,MCX,MCTR,MCNAM,MCCOL,MCROW

 S (MCARC,MCCOL,MCROW)=0

 S MCRHS=$O(^MCAR(697.3,"B",MCRHB,0)) I 'MCRHS W !!,"No Medicine View Screen for Rheumatology Patient Background." Q

 S MCHDR=$P($G(^MCAR(697.3,MCRHS,0)),"^",7)

 S MCLP=0 F  S MCLP=$O(^MCAR(697.3,MCRHS,1,"A",MCLP)) Q:MCLP<1  D

 .S MCLP1=0 F  S MCLP1=$O(^MCAR(697.3,MCRHS,1,"A",MCLP,MCLP1)) Q:MCLP1<1  S MCARR(MCLP)=MCLP1

 S MCLP=0 F  S MCLP=$O(MCARR(MCLP)) Q:MCLP<1  S MCX=$G(MCARR(MCLP)),MCARR(MCLP)=$G(^MCAR(697.3,MCRHS,1,MCX,0))

 S X="IOINHI;IOINLOW" D ENDR^%ZISS

 W @IOF,?17,MCHDR S MCLP=0 F  S MCLP=$O(MCARR(MCLP)) Q:MCLP<1  S MCX=$G(MCARR(MCLP)) D

 .S MCNAM=$P(MCX,"^"),MCCOL=$P(MCX,"^",2)

 .S MCROW=$P(MCCOL,","),MCCOL=$P(MCCOL,",",2)

 .S MCROW=$P(MCROW,"DY=",2),MCCOL=$P(MCCOL,"DX=",2)

 .I MCROW'=MCARC F MCTR=1:1 Q:MCARC=MCROW  W ! S MCARC=MCARC+1

 .W IOINHI

 .W ?MCCOL,MCLP

 .W IOINLOW

 .W " ",MCNAM_$S($E(MCNAM,$L(MCNAM))=":":"",1:":")

 .W IOINHI

 .W $G(MCARR1(MCLP))

 .W IOINLOW

 W !!,"FUNCTION: "

 W !!,"  ^ -- Quit"

 W !,"  N -- New record",!

 K DIR S DIR(0)="SOA^N:New Record",DIR("A")="FUNCTION:",DIR("B")="N" D ^DIR Q:$D(DIRUT)!($D(DIROUT))

 K DIRUT,DIROUT,IOINLOW,IOINHI

 Q

MCRH3     ; HOIFO/NCA - RHEUMATOLOGY Patient Background Info ;7/3/96  09:13

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

 +2       ; Reference IA #10088

EN1       ; Get the Medicine View File #697.3 entry.

 +1        NEW MCARC,MCHDR,MCRHS,MCARR,MCLP,MCLP1,MCX,MCTR,MCNAM,MCCOL,MCROW

 +2        SET (MCARC,MCCOL,MCROW)=0

 +3        SET MCRHS=$ORDER(^MCAR(697.3,"B",MCRHB,0))

           IF 'MCRHS

               WRITE !!,"No Medicine View Screen for Rheumatology Patient Background."

               QUIT 

 +4        SET MCHDR=$PIECE($GET(^MCAR(697.3,MCRHS,0)),"^",7)

 +5        SET MCLP=0

           FOR 

               SET MCLP=$ORDER(^MCAR(697.3,MCRHS,1,"A",MCLP))

               IF MCLP<1

                   QUIT 

               Begin DoDot:1

 +6                SET MCLP1=0

                   FOR 

                       SET MCLP1=$ORDER(^MCAR(697.3,MCRHS,1,"A",MCLP,MCLP1))

                       IF MCLP1<1

                           QUIT 

                       SET MCARR(MCLP)=MCLP1

               End DoDot:1

 +7        SET MCLP=0

           FOR 

               SET MCLP=$ORDER(MCARR(MCLP))

               IF MCLP<1

                   QUIT 

               SET MCX=$GET(MCARR(MCLP))

               SET MCARR(MCLP)=$GET(^MCAR(697.3,MCRHS,1,MCX,0))

 +8        SET X="IOINHI;IOINLOW"

           DO ENDR^%ZISS

 +9        WRITE @IOF,?17,MCHDR

           SET MCLP=0

           FOR 

               SET MCLP=$ORDER(MCARR(MCLP))

               IF MCLP<1

                   QUIT 

               SET MCX=$GET(MCARR(MCLP))

               Begin DoDot:1

 +10               SET MCNAM=$PIECE(MCX,"^")

                   SET MCCOL=$PIECE(MCX,"^",2)

 +11               SET MCROW=$PIECE(MCCOL,",")

                   SET MCCOL=$PIECE(MCCOL,",",2)

 +12               SET MCROW=$PIECE(MCROW,"DY=",2)

                   SET MCCOL=$PIECE(MCCOL,"DX=",2)

 +13               IF MCROW'=MCARC

                       FOR MCTR=1:1

                           IF MCARC=MCROW

                               QUIT 

                           WRITE !

                           SET MCARC=MCARC+1

 +14               WRITE IOINHI

 +15               WRITE ?MCCOL,MCLP

 +16               WRITE IOINLOW

 +17               WRITE " ",MCNAM_$SELECT($EXTRACT(MCNAM,$LENGTH(MCNAM))=":":"",1:":")

 +18               WRITE IOINHI

 +19               WRITE $GET(MCARR1(MCLP))

 +20               WRITE IOINLOW

               End DoDot:1

 +21       WRITE !!,"FUNCTION: "

 +22       WRITE !!,"  ^ -- Quit"

 +23       WRITE !,"  N -- New record",!

 +24       KILL DIR

           SET DIR(0)="SOA^N:New Record"

           SET DIR("A")="FUNCTION:"

           SET DIR("B")="N"

           DO ^DIR

           IF $DATA(DIRUT)!($DATA(DIROUT))

               QUIT 

 +25       KILL DIRUT,DIROUT,IOINLOW,IOINHI

 +26       QUIT