- 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
