MCARDBL.m

MCARDBL ;WISC/TJK-UTILITY TO ASTERIK OUT ENTRIES ON SCREEN AND FUNCTIONS ;5/2/96  12:54

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

START Q:'$D(DJBLO)  Q:DJBLO=""

 F DJBNO=1:1 S DJBITEM=$P(DJBLO,",",DJBNO) Q:DJBITEM=""  D

 .Q:'$D(DJJ(DJBITEM))  S DJDB=""

 .S $P(DJDB,"*",$P(DJJ(DJBITEM),U)+1)=""

 .S @($P(DJJ(DJBITEM),U,2))

 .K DJP1,DJP2,DJP8

 .X XY W DJDB S DJBHOLD=DJJ(DJBITEM),DJBITEM1=DJBITEM K DJJ(DJBITEM),V(DJBITEM)

 S DY=16,DX=15 X XY W DJHIN,"[Asterisks (*) indicate field n/a to this record]          "

 G EXIT:$D(DJJ(V))

 S DJNX=$O(DJJ(V)) I DJNX="" S DY=17,DX=0 X XY W "Press <RETURN> to Continue" S V=DJBITEM1,DJJ(V)=DJBHOLD,DJNX=DJBITEM1,$P(DJJ(V),U,1,2)="2^DY=17,DX=27"

 E  S V=DJNX

EXIT K DJBLO,DJBNO,DJDB,DJBITEM,DJBITEM1,DJBHOLD

 Q

FUNC ;Functions

 ;DCB-Function commands.

 I X="^T",$D(DJTOGGLE) W IOKPNM K DJTOGGLE D HELP G R^MCARDNJ

 I X="^T",'$D(DJTOGGLE) W IOKPAM S DJTOGGLE="" D HELP G R^MCARDNJ

 I X="^C" D HELP1 G R^MCARDNJ

 I X="^R" S DA=D0,DJNM=DJDPL,DJFLAG=V,MCMASS=1 K MCDID D ^MCARDPL D ^MCARD1 G EN^MCARDNJ

 ;I X="^K" S MCMASS=1 K MCDID D FUNCK^MCARDNQ2 G R^MCARDNJ

 I X="^O",'$D(MCHELPSW) S MCHELPSW=0 K MCDID S MCMASS=1 G TK^MCARDNJ

 I X="^O",$D(MCHELPSW) K MCHELPSW K MCDID S MCMASS=1 G TK^MCARDNJ

 I X="^H" S MCHELPS2=1 D START^MCARDHLP K MCDID,MCHELPS2 S MCMASS=1 G R^MCARDNJ

 G RETURN^MCARDNJ

HELP ;

 Q:'$D(MCHELPSW)

HELP1 ;

 I '$D(DJTOGGLE) D FUNCC^MCARDNQ2

 E  D FUNCK^MCARDNQ2

 Q

MCARDBL   ;WISC/TJK-UTILITY TO ASTERIK OUT ENTRIES ON SCREEN AND FUNCTIONS ;5/2/96  12:54

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

START      IF '$DATA(DJBLO)

               QUIT 

           IF DJBLO=""

               QUIT 

 +1        FOR DJBNO=1:1

               SET DJBITEM=$PIECE(DJBLO,",",DJBNO)

               IF DJBITEM=""

                   QUIT 

               Begin DoDot:1

 +2                IF '$DATA(DJJ(DJBITEM))

                       QUIT 

                   SET DJDB=""

 +3                SET $PIECE(DJDB,"*",$PIECE(DJJ(DJBITEM),U)+1)=""

 +4                SET @($PIECE(DJJ(DJBITEM),U,2))

 +5                KILL DJP1,DJP2,DJP8

 +6                XECUTE XY

                   WRITE DJDB

                   SET DJBHOLD=DJJ(DJBITEM)

                   SET DJBITEM1=DJBITEM

                   KILL DJJ(DJBITEM),V(DJBITEM)

               End DoDot:1

 +7        SET DY=16

           SET DX=15

           XECUTE XY

           WRITE DJHIN,"[Asterisks (*) indicate field n/a to this record]          "

 +8        IF $DATA(DJJ(V))

               GOTO EXIT

 +9        SET DJNX=$ORDER(DJJ(V))

           IF DJNX=""

               SET DY=17

               SET DX=0

               XECUTE XY

               WRITE "Press <RETURN> to Continue"

               SET V=DJBITEM1

               SET DJJ(V)=DJBHOLD

               SET DJNX=DJBITEM1

               SET $PIECE(DJJ(V),U,1,2)="2^DY=17,DX=27"

 +10      IF '$TEST

               SET V=DJNX

EXIT       KILL DJBLO,DJBNO,DJDB,DJBITEM,DJBITEM1,DJBHOLD

 +1        QUIT 

FUNC      ;Functions

 +1       ;DCB-Function commands.

 +2        IF X="^T"

               IF $DATA(DJTOGGLE)

                   WRITE IOKPNM

                   KILL DJTOGGLE

                   DO HELP

                   GOTO R^MCARDNJ

 +3        IF X="^T"

               IF '$DATA(DJTOGGLE)

                   WRITE IOKPAM

                   SET DJTOGGLE=""

                   DO HELP

                   GOTO R^MCARDNJ

 +4        IF X="^C"

               DO HELP1

               GOTO R^MCARDNJ

 +5        IF X="^R"

               SET DA=D0

               SET DJNM=DJDPL

               SET DJFLAG=V

               SET MCMASS=1

               KILL MCDID

               DO ^MCARDPL

               DO ^MCARD1

               GOTO EN^MCARDNJ

 +6       ;I X="^K" S MCMASS=1 K MCDID D FUNCK^MCARDNQ2 G R^MCARDNJ

 +7        IF X="^O"

               IF '$DATA(MCHELPSW)

                   SET MCHELPSW=0

                   KILL MCDID

                   SET MCMASS=1

                   GOTO TK^MCARDNJ

 +8        IF X="^O"

               IF $DATA(MCHELPSW)

                   KILL MCHELPSW

                   KILL MCDID

                   SET MCMASS=1

                   GOTO TK^MCARDNJ

 +9        IF X="^H"

               SET MCHELPS2=1

               DO START^MCARDHLP

               KILL MCDID,MCHELPS2

               SET MCMASS=1

               GOTO R^MCARDNJ

 +10       GOTO RETURN^MCARDNJ

HELP      ;

 +1        IF '$DATA(MCHELPSW)

               QUIT 

HELP1     ;

 +1        IF '$DATA(DJTOGGLE)

               DO FUNCC^MCARDNQ2

 +2       IF '$TEST

               DO FUNCK^MCARDNQ2

 +3        QUIT