MCARD.m

MCARD ;WISC/TJK,JA-SCREEN HANDLER ;7/22/96  14:55

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

EN K ^TMP($J,"DJST"),DJST,^TMP($J,"DJ") S:$D(DJSC) X=DJSC S DJPEDT=$P(^VA(200,DUZ,1),U,5)

 S Y=$O(^MCAR(697.3,"B",X,0)) S:Y="" Y=-1

 I Y<0 W !!,"SCREEN NOT DEFINED",*7 Q

 ;WISC/DCB-The next line sets up the PF and cursor keys for input

 S X="IOPF1;IOPF2;IOPF3;IOPF4;IOECH;IOCUB;IOCUF;IOCUD;IOCUU;IOKP1;IOKP2"

 D ENDR^%ZISS

 S X="IOKP3;IOKP4;IOKP5;IOKP6;IOKP7;IOKP8;IOKP9;IORVOFF;IORVON;IOKPAM;IOKPNM"

 D ENDR^%ZISS

 W IOKPNM S DJCHO="C",MCMASS=1,MCHELPSW=1

 S DJR=Y,DJR(0)=^MCAR(697.3,Y,0),DJZ=$P(DJR(0),"^",6) I '$D(DJZ) S DJZ=$S(DJZ="":"",$D(^DIC(DJZ,0,"GL"))=1:^("GL"),1:"") I DJZ=""!($D(^MCAR(697.3,+Y,1))=0) W !,"SCREEN OR GLOBAL NOT DEFINED PROPERLY",*7 H 1 Q

 S DJNM=$P(^MCAR(697.3,Y,0),"^",1) G:$D(DJDN) D

RD ;D RL Q:X="^"!(X="")  G RD

RL K V

D D:'$D(DJRJ) ^MCARDPAR Q:'$D(DJRJ)

 I '$D(DJDN) D ^MCARDPL G EXIT1:$D(DJY) D ^MCARDNJ G EXIT1

 I '$D(DJDIS),$D(DJDN) D ^MCARDPL G EXIT1:$D(DJY) S (DA,W(V))=DJDN D ^MCARD1 S DJW=1,DJW1=1 D EN^MCARDNJ G EXIT1

 I $D(DJDIS) D ^MCARDPL G EXIT1:$D(DJY) S (DA,W(V))=DJDN D ^MCARD1 S DJW=1,DJW1=1 D EN^MCARDNJ G EXIT1

 ;

Q ; LOCATE SCREEN

 D:'$D(DJRJ) ^MCARDPAR Q:'$D(DJRJ)

 S DIC("A")="Select Screen Name: ",DIC(0)="AEMQ",DIC="^MCAR(697.3," S:DJOP=2 DLAYGO=697.3,DIC(0)=DIC(0)_"L"

 S DIC("S")=$S(DUZ(0)'="@":"I 1 S DJX=$P(^MCAR(697.3,+Y,0),""^"",4) F DJK=1:1:$L(DJX) I DUZ(0)[$E(DJX,DJK) Q",1:"I Y") I DJOP=5 S DIC("S")="I $P(^MCAR(697.3,+Y,0),""^"",3)="""",'$D(^DD($P(^MCAR(697.3,+Y,0),""^"",6),0,""UP"")) "_DIC("S")

 D ^DIC K DIC(0),DLAYGO,DIC("A"),DIC("S") Q:Y<0

 S (X,DJDNM)=$P(Y,U,2) Q

EX K DIC,DJRJ,I,J,K,O,S,X,XY Q

EXIT1 X DJCL W DJLIN K DJLIN,DJCL,DJCP,DJEOP,DJRJ,DJR I $D(IOST),IOST?1"C-Q".E W DJHIN

 K DJHIN

EXIT I $D(X),X=U S DUOUT=""

 W IOKPNM

 K DJJ,C,V,X,Y,DIC,DJQ,DJDPL,DJKV,DJNM,DJW,DIE,DE,DJ,DH,DI,DJDIS,DJW1,DJDN,DJ0,DJAT,DJMU,DJST,DJSC,DJI,DJOP,DWLW,DJLG,DJNN,DJSW2,DIADD

 K D,D0,DA,DJ4,DJ3,DJ2,DJDD,DJDNM,DJERR,DJF,DJL,DJN,DJP,DJRNM,DJT,DJX,DJY,DJZ,DFAST,DU,MCARDC,MCDSPTYP

 K ^TMP($J,"DJST"),DJ5,DJ6,DJ7,DJ9,DJA,DJAD,DJBD,DJD,DJDA,DJDP,DJDUZ,DJFF,DJLSTN,DJSM,DJ44,DJNODE,XY

 K DJ11,DJ01,DJXL,DJXT,DJXX,DJX1,DJX3,DJ8,DX,DY,DJK,DJDIC,DJDICS,W,DJWR,D0,MCDF,MCBDIC,MCHELPSW,DJCHO

 K IOPF1,IOPF2,IOPF3,IOPF4,IOECH,IOCUB,IOCUF,IOCUD,IOCUU,IORVON

 K IOKP1,IOKP2,IOKP3,IOKP4,IOKP5,IOKP6,IOKP7,IOKP8,IOKP9,IORVOFF

 K DJTOGGLE

 Q

 ;

MCARD     ;WISC/TJK,JA-SCREEN HANDLER ;7/22/96  14:55

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

EN         KILL ^TMP($JOB,"DJST"),DJST,^TMP($JOB,"DJ")

           IF $DATA(DJSC)

               SET X=DJSC

           SET DJPEDT=$PIECE(^VA(200,DUZ,1),U,5)

 +1        SET Y=$ORDER(^MCAR(697.3,"B",X,0))

           IF Y=""

               SET Y=-1

 +2        IF Y<0

               WRITE !!,"SCREEN NOT DEFINED",*7

               QUIT 

 +3       ;WISC/DCB-The next line sets up the PF and cursor keys for input

 +4        SET X="IOPF1;IOPF2;IOPF3;IOPF4;IOECH;IOCUB;IOCUF;IOCUD;IOCUU;IOKP1;IOKP2"

 +5        DO ENDR^%ZISS

 +6        SET X="IOKP3;IOKP4;IOKP5;IOKP6;IOKP7;IOKP8;IOKP9;IORVOFF;IORVON;IOKPAM;IOKPNM"

 +7        DO ENDR^%ZISS

 +8        WRITE IOKPNM

           SET DJCHO="C"

           SET MCMASS=1

           SET MCHELPSW=1

 +9        SET DJR=Y

           SET DJR(0)=^MCAR(697.3,Y,0)

           SET DJZ=$PIECE(DJR(0),"^",6)

           IF '$DATA(DJZ)

               SET DJZ=$SELECT(DJZ="":"",$DATA(^DIC(DJZ,0,"GL"))=1:^("GL"),1:"")

               IF DJZ=""!($DATA(^MCAR(697.3,+Y,1))=0)

                   WRITE !,"SCREEN OR GLOBAL NOT DEFINED PROPERLY",*7

                   HANG 1

                   QUIT 

 +10       SET DJNM=$PIECE(^MCAR(697.3,Y,0),"^",1)

           IF $DATA(DJDN)

               GOTO D

RD        ;D RL Q:X="^"!(X="")  G RD

RL         KILL V

D          IF '$DATA(DJRJ)

               DO ^MCARDPAR

           IF '$DATA(DJRJ)

               QUIT 

 +1        IF '$DATA(DJDN)

               DO ^MCARDPL

               IF $DATA(DJY)

                   GOTO EXIT1

               DO ^MCARDNJ

               GOTO EXIT1

 +2        IF '$DATA(DJDIS)

               IF $DATA(DJDN)

                   DO ^MCARDPL

                   IF $DATA(DJY)

                       GOTO EXIT1

                   SET (DA,W(V))=DJDN

                   DO ^MCARD1

                   SET DJW=1

                   SET DJW1=1

                   DO EN^MCARDNJ

                   GOTO EXIT1

 +3        IF $DATA(DJDIS)

               DO ^MCARDPL

               IF $DATA(DJY)

                   GOTO EXIT1

               SET (DA,W(V))=DJDN

               DO ^MCARD1

               SET DJW=1

               SET DJW1=1

               DO EN^MCARDNJ

               GOTO EXIT1

 +4       ;

Q         ; LOCATE SCREEN

 +1        IF '$DATA(DJRJ)

               DO ^MCARDPAR

           IF '$DATA(DJRJ)

               QUIT 

 +2        SET DIC("A")="Select Screen Name: "

           SET DIC(0)="AEMQ"

           SET DIC="^MCAR(697.3,"

           IF DJOP=2

               SET DLAYGO=697.3

               SET DIC(0)=DIC(0)_"L"

 +3        SET DIC("S")=$SELECT(DUZ(0)'="@":"I 1 S DJX=$P(^MCAR(697.3,+Y,0),""^"",4) F DJK=1:1:$L(DJX) I DUZ(0)[$E(DJX,DJK) Q",1:"I Y")

           IF DJOP=5

               SET DIC("S")="I $P(^MCAR(697.3,+Y,0),""^"",3)="""",'$D(^DD($P(^MCAR(697.3,+Y,0),""^"",6),0,""UP"")) "_DIC("S")

 +4        DO ^DIC

           KILL DIC(0),DLAYGO,DIC("A"),DIC("S")

           IF Y<0

               QUIT 

 +5        SET (X,DJDNM)=$PIECE(Y,U,2)

           QUIT 

EX         KILL DIC,DJRJ,I,J,K,O,S,X,XY

           QUIT 

EXIT1      XECUTE DJCL

           WRITE DJLIN

           KILL DJLIN,DJCL,DJCP,DJEOP,DJRJ,DJR

           IF $DATA(IOST)

               IF IOST?1"C-Q".E

                   WRITE DJHIN

 +1        KILL DJHIN

EXIT       IF $DATA(X)

               IF X=U

                   SET DUOUT=""

 +1        WRITE IOKPNM

 +2        KILL DJJ,C,V,X,Y,DIC,DJQ,DJDPL,DJKV,DJNM,DJW,DIE,DE,DJ,DH,DI,DJDIS,DJW1,DJDN,DJ0,DJAT,DJMU,DJST,DJSC,DJI,DJOP,DWLW,DJLG,DJNN,DJSW2,DIADD

 +3        KILL D,D0,DA,DJ4,DJ3,DJ2,DJDD,DJDNM,DJERR,DJF,DJL,DJN,DJP,DJRNM,DJT,DJX,DJY,DJZ,DFAST,DU,MCARDC,MCDSPTYP

 +4        KILL ^TMP($JOB,"DJST"),DJ5,DJ6,DJ7,DJ9,DJA,DJAD,DJBD,DJD,DJDA,DJDP,DJDUZ,DJFF,DJLSTN,DJSM,DJ44,DJNODE,XY

 +5        KILL DJ11,DJ01,DJXL,DJXT,DJXX,DJX1,DJX3,DJ8,DX,DY,DJK,DJDIC,DJDICS,W,DJWR,D0,MCDF,MCBDIC,MCHELPSW,DJCHO

 +6        KILL IOPF1,IOPF2,IOPF3,IOPF4,IOECH,IOCUB,IOCUF,IOCUD,IOCUU,IORVON

 +7        KILL IOKP1,IOKP2,IOKP3,IOKP4,IOKP5,IOKP6,IOKP7,IOKP8,IOKP9,IORVOFF

 +8        KILL DJTOGGLE

 +9        QUIT 

 +10      ;