ACMESDT.m

ACMESDT ; IHS/TUCSON/TMJ - DATA ENTRY OF CMS SUPPORTING DATA ;

 ;;2.0;ACM CASE MANAGEMENT SYSTEM;;JAN 10, 1996

 ;DATA ENTRY FOR CMS SYSTEMS DATA

EN ;

READ ;get user entered value

 K DIC

 D ESDT

 S DIC(0)="AEQOL",DIC("A")=$P(ACMENTRY,";;",5)

 ;Screen for lookup of Register Lists

 I '$P(^ACM(41.1,ACMRG,0),U,8) S:ACMDIC'=41&(ACMDIC'=46)&(ACMDIC'=57)&(ACMDIC'=50) DIC("S")="I $D(@ACMDIC2@(+Y,""RG"",""B"",ACMRG))"

 ;I '$T!(ACMY="^")!(ACMY="") K ACMDM S ACMQUIT="" G EXIT ;timed out,entered ^ or entered ""

 ;I ACMY["?" S DIC(0)="MQ",D="B",DZ="??" D DQ^DICQ K DIC("S") D PAUSE G READ

 ;S X=ACMY,DIC(0)="EMQL" 

 D DIC

 I $E(X)=U!(X="") K ACMDM S ACMQUIT="" G EXIT

 I Y=-1 W !!,"Invalid value for a ",$P($P(ACMENTRY,";;",5),":"),"!  TRY AGAIN." K DIC D PAUSE G READ

 I DR[".03" S DR=DR_$S($D(ACMRGNA):"///"_ACMRGNA,1:"")

 D DIE:'$D(ACMQUIT)!((ACMDIC=41.1)&'$D(ACMMGR))

 ;I '$D(ACMQUIT),ACMDIC=44.1 S ACMDXDA=ACMDA D EN11^ACMDXIT K ACMQUIT

 G EN:'$D(ACMQUIT)

EXIT K ACMENTRX,ACMTITLE

 K ACMX,ACMZ,ACMDR,ACMRGMGR,ACMRGUSR,ACMDIC,ACMDIC1,ACMDIC2,ACMY

 Q

ESDT D HEAD^ACMMENU

 K ACMQUIT

 S ACMTITLE=$P(ACMENTRY,";;",2),ACMDIC=$P(ACMENTRY,";;",3),(DIC,DIE)="^ACM("_ACMDIC_",",DR=$P(ACMENTRY,";;",4),ACMDIC2="^ACM("_ACMDIC_")"

HEAD S ACMX=ACMTITLE_" MANAGEMENT UTILITY"

 W !?80-$L(ACMX)\2,ACMX,!!?14,"Update ",@ACMRVON,ACMTITLE,@ACMRVOFF

 Q

PAUSE ;

 Q:$E(IOST)'="C"!(IO'=IO(0))

 W ! S DIR(0)="EO",DIR("A")="Hit return to continue...." D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 Q

DIC W ! D ^DIC K DIC Q

DIE S (ACMDA,DA)=+Y D ^DIE K DIC,DIE,DA,DR Q

ENTRY ;EP;TO SET SEQUENCE PROCESSING VARIABLE

 S ACMENTRY=$T(@ACMENTRY^ACMCTRL1) G EN

ACMESDT   ; IHS/TUCSON/TMJ - DATA ENTRY OF CMS SUPPORTING DATA ;

 +1       ;;2.0;ACM CASE MANAGEMENT SYSTEM;;JAN 10, 1996

 +2       ;DATA ENTRY FOR CMS SYSTEMS DATA

EN        ;

READ      ;get user entered value

 +1        KILL DIC

 +2        DO ESDT

 +3        SET DIC(0)="AEQOL"

           SET DIC("A")=$PIECE(ACMENTRY,";;",5)

 +4       ;Screen for lookup of Register Lists

 +5        IF '$PIECE(^ACM(41.1,ACMRG,0),U,8)

               IF ACMDIC'=41&(ACMDIC'=46)&(ACMDIC'=57)&(ACMDIC'=50)

                   SET DIC("S")="I $D(@ACMDIC2@(+Y,""RG"",""B"",ACMRG))"

 +6       ;I '$T!(ACMY="^")!(ACMY="") K ACMDM S ACMQUIT="" G EXIT ;timed out,entered ^ or entered ""

 +7       ;I ACMY["?" S DIC(0)="MQ",D="B",DZ="??" D DQ^DICQ K DIC("S") D PAUSE G READ

 +8       ;S X=ACMY,DIC(0)="EMQL" 

 +9        DO DIC

 +10       IF $EXTRACT(X)=U!(X="")

               KILL ACMDM

               SET ACMQUIT=""

               GOTO EXIT

 +11       IF Y=-1

               WRITE !!,"Invalid value for a ",$PIECE($PIECE(ACMENTRY,";;",5),":"),"!  TRY AGAIN."

               KILL DIC

               DO PAUSE

               GOTO READ

 +12       IF DR[".03"

               SET DR=DR_$SELECT($DATA(ACMRGNA):"///"_ACMRGNA,1:"")

 +13       IF '$DATA(ACMQUIT)!((ACMDIC=41.1)&'$DATA(ACMMGR))

               DO DIE

 +14      ;I '$D(ACMQUIT),ACMDIC=44.1 S ACMDXDA=ACMDA D EN11^ACMDXIT K ACMQUIT

 +15       IF '$DATA(ACMQUIT)

               GOTO EN

EXIT       KILL ACMENTRX,ACMTITLE

 +1        KILL ACMX,ACMZ,ACMDR,ACMRGMGR,ACMRGUSR,ACMDIC,ACMDIC1,ACMDIC2,ACMY

 +2        QUIT 

ESDT       DO HEAD^ACMMENU

 +1        KILL ACMQUIT

 +2        SET ACMTITLE=$PIECE(ACMENTRY,";;",2)

           SET ACMDIC=$PIECE(ACMENTRY,";;",3)

           SET (DIC,DIE)="^ACM("_ACMDIC_","

           SET DR=$PIECE(ACMENTRY,";;",4)

           SET ACMDIC2="^ACM("_ACMDIC_")"

HEAD       SET ACMX=ACMTITLE_" MANAGEMENT UTILITY"

 +1        WRITE !?80-$LENGTH(ACMX)\2,ACMX,!!?14,"Update ",@ACMRVON,ACMTITLE,@ACMRVOFF

 +2        QUIT 

PAUSE     ;

 +1        IF $EXTRACT(IOST)'="C"!(IO'=IO(0))

               QUIT 

 +2        WRITE !

           SET DIR(0)="EO"

           SET DIR("A")="Hit return to continue...."

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +3        QUIT 

DIC        WRITE !

           DO ^DIC

           KILL DIC

           QUIT 

DIE        SET (ACMDA,DA)=+Y

           DO ^DIE

           KILL DIC,DIE,DA,DR

           QUIT 

ENTRY     ;EP;TO SET SEQUENCE PROCESSING VARIABLE

 +1        SET ACMENTRY=$TEXT(@ACMENTRY^ACMCTRL1)

           GOTO EN