VAUTOMA ;ALB/MLI - GENERIC ONE, MANY, ALL ROUTINE ;03/26/2004
;;5.3;Registration;**111,568,850**;Aug 13, 1993;Build 171
;;MAS VERSION 5.1;
DIVISION S VAUTVB="VAUTD",DIC="^DG(40.8,",VAUTNI=2,VAUTSTR="division" G FIRST
CLINIC S DIC="^SC(",DIC("S")="I $P(^(0),U,3)=""C""&'+$P($G(^(""OOS"")),U,1)&'+$P($G(^(""OOS"")),U,2)&$S(VAUTD:1,$D(VAUTD(+$P(^(0),U,15))):1,'+$P(^(0),U,15)&$D(VAUTD(+$O(^DG(40.8,0)))):1,1:0)",VAUTSTR="clinic",VAUTVB="VAUTC" G FIRST
; DIC("S") modified in CLINIC call, to exclude Occasion of Service locations. abr - 11/25/96
;
PATIENT S DIC="^DPT(",VAUTSTR="patient",VAUTVB="VAUTN" K DIC("IGNORE") G FIRST
WARD S DIC="^DIC(42,",VAUTSTR="ward",VAUTVB="VAUTW",DIC("S")="I $S(VAUTD:1,$D(VAUTD(+$P(^(0),U,11))):1,'+$P(^(0),U,11)&$D(VAUTD(^DG(40.8,+$O(^DG(40.8,0)),0))):1,1:0)" G FIRST
FIRST S DIC(0)="EQMNZ",DIC("A")="Select "_VAUTSTR_": " K @VAUTVB S (@VAUTVB,Y)=0
I $G(DIC("IGNORE"))=1 I DIC=80!(DIC=80.1)!(DIC="^ICD9(")!(DIC="^ICD0(") S DIC(0)=DIC(0)_"I" K DIC("IGNORE")
REDO W !,DIC("A") W:'$D(VAUTNALL) "ALL// " R X:DTIME G ERR:(X="^")!'$T D:X["?" QQ I X="" G:$D(VAUTNALL) ERR S @VAUTVB=1 G QUIT
S DIC("A")="Select another "_VAUTSTR_": " D ^DIC G:Y'>0 FIRST D SET
F VAI=1:0:19 W !,DIC("A") R X:DTIME G ERR:(X="^")!'$T K Y Q:X="" D QQ:X["?" S:$E(X)="-" VAUTX=X,X=$E(VAUTX,2,999) D ^DIC I Y>0 D SET G:VAX REDO S:'VAERR VAI=VAI+1
G QUIT
SET S VAX=0 I $D(VAUTX) S J=$S(VAUTNI=2:+Y,1:$P(Y(0),"^")) K VAUTX S VAERR=$S($D(@VAUTVB@(J)):0,1:1) W $S('VAERR:"...removed from list...",1:"...not on list...can't remove") Q:VAERR S VAI=VAI-1 K @VAUTVB@(J) S:$O(@VAUTVB@(0))']"" VAX=1 Q
S VAERR=0 I $S($D(@VAUTVB@($P(Y(0),U))):1,$D(@VAUTVB@(+Y)):1,1:0) W !?3,*7,"You have already selected that ",VAUTSTR,". Try again." S VAERR=1
I VAUTNI=1 S @VAUTVB@($P(Y(0),U))=+Y Q
I VAUTNI=3 S @VAUTVB@($P(Y(0,0),U))=+Y Q
S @VAUTVB@(+Y)=$P(Y(0),U) Q
QQ W !,"ENTER:" W:($D(@(VAUTVB))=1&'$D(VAUTNALL)) !?5,"- Return for all ",VAUTSTR,"s, or" W !?5,"- A ",VAUTSTR," and return when all ",VAUTSTR,"s have been selected--limit 20"
W !?5,"Imprecise selections will yield an additional prompt."
W !?5,"(e.g. When a user enters 'A', all items beginning with 'A' are displayed.)"
I $O(@VAUTVB@(0))]"" W !?5,"- An entry preceeded by a minus [-] sign to remove entry from list."
I $O(@VAUTVB@(0))]"" W !,"NOTE, you have already selected:" S VAJ=0 F VAJ1=0:0 S VAJ=$O(@VAUTVB@(VAJ)) Q:VAJ="" W !?8,$S(VAUTNI=1:VAJ,1:@VAUTVB@(VAJ))
Q
ERR S Y=-1
QUIT S:'$D(Y) Y=1 K DIC,J,VAERR,VAI,VAJ,VAJ1,VAX,VAUTNALL,VAUTNI,VAUTSTR,VAUTVB,X Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAUTOMA 2557 printed Dec 13, 2024@03:04:01 Page 2
VAUTOMA ;ALB/MLI - GENERIC ONE, MANY, ALL ROUTINE ;03/26/2004
+1 ;;5.3;Registration;**111,568,850**;Aug 13, 1993;Build 171
+2 ;;MAS VERSION 5.1;
DIVISION SET VAUTVB="VAUTD"
SET DIC="^DG(40.8,"
SET VAUTNI=2
SET VAUTSTR="division"
GOTO FIRST
CLINIC SET DIC="^SC("
SET DIC("S")="I $P(^(0),U,3)=""C""&'+$P($G(^(""OOS"")),U,1)&'+$P($G(^(""OOS"")),U,2)&$S(VAUTD:1,$D(VAUTD(+$P(^(0),U,15))):1,'+$P(^(0),U,15)&$D(VAUTD(+$O(^DG(40.8,0)))):1,1:0)"
SET VAUTSTR="clinic"
SET VAUTVB="VAUTC"
GOTO FIRST
+1 ; DIC("S") modified in CLINIC call, to exclude Occasion of Service locations. abr - 11/25/96
+2 ;
PATIENT SET DIC="^DPT("
SET VAUTSTR="patient"
SET VAUTVB="VAUTN"
KILL DIC("IGNORE")
GOTO FIRST
WARD SET DIC="^DIC(42,"
SET VAUTSTR="ward"
SET VAUTVB="VAUTW"
SET DIC("S")="I $S(VAUTD:1,$D(VAUTD(+$P(^(0),U,11))):1,'+$P(^(0),U,11)&$D(VAUTD(^DG(40.8,+$O(^DG(40.8,0)),0))):1,1:0)"
GOTO FIRST
FIRST SET DIC(0)="EQMNZ"
SET DIC("A")="Select "_VAUTSTR_": "
KILL @VAUTVB
SET (@VAUTVB,Y)=0
+1 IF $GET(DIC("IGNORE"))=1
IF DIC=80!(DIC=80.1)!(DIC="^ICD9(")!(DIC="^ICD0(")
SET DIC(0)=DIC(0)_"I"
KILL DIC("IGNORE")
REDO WRITE !,DIC("A")
if '$DATA(VAUTNALL)
WRITE "ALL// "
READ X:DTIME
if (X="^")!'$TEST
GOTO ERR
if X["?"
DO QQ
IF X=""
if $DATA(VAUTNALL)
GOTO ERR
SET @VAUTVB=1
GOTO QUIT
+1 SET DIC("A")="Select another "_VAUTSTR_": "
DO ^DIC
if Y'>0
GOTO FIRST
DO SET
+2 FOR VAI=1:0:19
WRITE !,DIC("A")
READ X:DTIME
if (X="^")!'$TEST
GOTO ERR
KILL Y
if X=""
QUIT
if X["?"
DO QQ
if $EXTRACT(X)="-"
SET VAUTX=X
SET X=$EXTRACT(VAUTX,2,999)
DO ^DIC
IF Y>0
DO SET
if VAX
GOTO REDO
if 'VAERR
SET VAI=VAI+1
+3 GOTO QUIT
SET SET VAX=0
IF $DATA(VAUTX)
SET J=$SELECT(VAUTNI=2:+Y,1:$PIECE(Y(0),"^"))
KILL VAUTX
SET VAERR=$SELECT($DATA(@VAUTVB@(J)):0,1:1)
WRITE $SELECT('VAERR:"...removed from list...",1:"...not on list...can't remove")
if VAERR
QUIT
SET VAI=VAI-1
KILL @VAUTVB@(J)
if $ORDER(@VAUTVB@(0))']""
SET VAX=1
QUIT
+1 SET VAERR=0
IF $SELECT($DATA(@VAUTVB@($PIECE(Y(0),U))):1,$DATA(@VAUTVB@(+Y)):1,1:0)
WRITE !?3,*7,"You have already selected that ",VAUTSTR,". Try again."
SET VAERR=1
+2 IF VAUTNI=1
SET @VAUTVB@($PIECE(Y(0),U))=+Y
QUIT
+3 IF VAUTNI=3
SET @VAUTVB@($PIECE(Y(0,0),U))=+Y
QUIT
+4 SET @VAUTVB@(+Y)=$PIECE(Y(0),U)
QUIT
QQ WRITE !,"ENTER:"
if ($DATA(@(VAUTVB))=1&'$DATA(VAUTNALL))
WRITE !?5,"- Return for all ",VAUTSTR,"s, or"
WRITE !?5,"- A ",VAUTSTR," and return when all ",VAUTSTR,"s have been selected--limit 20"
+1 WRITE !?5,"Imprecise selections will yield an additional prompt."
+2 WRITE !?5,"(e.g. When a user enters 'A', all items beginning with 'A' are displayed.)"
+3 IF $ORDER(@VAUTVB@(0))]""
WRITE !?5,"- An entry preceeded by a minus [-] sign to remove entry from list."
+4 IF $ORDER(@VAUTVB@(0))]""
WRITE !,"NOTE, you have already selected:"
SET VAJ=0
FOR VAJ1=0:0
SET VAJ=$ORDER(@VAUTVB@(VAJ))
if VAJ=""
QUIT
WRITE !?8,$SELECT(VAUTNI=1:VAJ,1:@VAUTVB@(VAJ))
+5 QUIT
ERR SET Y=-1
QUIT if '$DATA(Y)
SET Y=1
KILL DIC,J,VAERR,VAI,VAJ,VAJ1,VAX,VAUTNALL,VAUTNI,VAUTSTR,VAUTVB,X
QUIT
