- QAMDUP0 ;HISC/DAD-COPY OLD MONITOR TO NEW ONE ;2/10/92 07:33
- ;;1.0;Clinical Monitoring System;;09/13/1993
- EN1 K DIC,DIDEL,DINUM,DLAYGO S DIC="^QA(743,",DIC(0)="AEMNQZ",DIC("A")="Select MONITOR TO COPY: " W ! D ^DIC K DIC G:Y'>0 EXIT
- S QAMD0=+Y,QAMCODE=$E("Copy of "_$P(Y(0),"^"),1,30),QAMTITLE=$E("Copy of "_$P(Y(0),"^",2),1,30)
- S QAMS0=$O(^QA(743,"B",QAMCODE,0)) I QAMS0 W !!?5,"*** A `",QAMCODE,"' already exists! ***",*7 S QAMD0=QAMS0 G EDIT
- ASK W !!,"Are you sure you want to copy this monitor" S %=2 D YN^DICN G EN1:%=2,EXIT:%=-1
- I '% W !!?5,"Answering Y(es) produces a duplicate copy of the selected monitor",!?5,"which you may then edit. Answering N(o) takes you back to the",!?5,"previous prompt." G ASK
- W !!,"Copying monitor, please wait..."
- S QAMZERO=^QA(743,0),QAMS0=$P(QAMZERO,"^",3)+1 F QAMS0=QAMS0:1 L +^QA(743,QAMS0,0):0 Q:$T&('$D(^QA(743,QAMS0,0))) L -^QA(743,QAMS0,0):0
- S $P(^QA(743,0),"^",3,4)=QAMS0_"^"_($P(QAMZERO,"^",4)+1)
- S %X="^QA(743,"_QAMD0_",",%Y="^QA(743,"_QAMS0_"," L -^QA(743,QAMS0,0):0 D %XY^%RCR S DIK="^QA(743,",DA=QAMS0 D IX^DIK S QAMD0=QAMS0
- EDIT K DR S DIE="^QA(743,",DR=".01///"_QAMCODE_";.02///"_QAMTITLE_";7///UNDER CONSTRUCTION;54///OFF",DA=QAMD0 D ^DIE S QAMFIN=0
- W !!,"You may now edit the copy of the monitor, please change the CODE and TITLE.",! D EN2^QAMEDT0 G EN1
- EXIT ;
- K %,%DT,%X,%Y,D0,D1,DA,DI,DIC,DIE,DIK,DQ,DR,J,QA,QAM,QAMAUTO,QAMCODE,QAMD0,QAMD1,QAMDFLT,QAMFIN,QAMPCODE,QAMS0,QAMTITLE,QAMZERO,X,Y
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAMDUP0 1480 printed Mar 13, 2025@20:46:56 Page 2
- QAMDUP0 ;HISC/DAD-COPY OLD MONITOR TO NEW ONE ;2/10/92 07:33
- +1 ;;1.0;Clinical Monitoring System;;09/13/1993
- EN1 KILL DIC,DIDEL,DINUM,DLAYGO
- SET DIC="^QA(743,"
- SET DIC(0)="AEMNQZ"
- SET DIC("A")="Select MONITOR TO COPY: "
- WRITE !
- DO ^DIC
- KILL DIC
- if Y'>0
- GOTO EXIT
- +1 SET QAMD0=+Y
- SET QAMCODE=$EXTRACT("Copy of "_$PIECE(Y(0),"^"),1,30)
- SET QAMTITLE=$EXTRACT("Copy of "_$PIECE(Y(0),"^",2),1,30)
- +2 SET QAMS0=$ORDER(^QA(743,"B",QAMCODE,0))
- IF QAMS0
- WRITE !!?5,"*** A `",QAMCODE,"' already exists! ***",*7
- SET QAMD0=QAMS0
- GOTO EDIT
- ASK WRITE !!,"Are you sure you want to copy this monitor"
- SET %=2
- DO YN^DICN
- if %=2
- GOTO EN1
- if %=-1
- GOTO EXIT
- +1 IF '%
- WRITE !!?5,"Answering Y(es) produces a duplicate copy of the selected monitor",!?5,"which you may then edit. Answering N(o) takes you back to the",!?5,"previous prompt."
- GOTO ASK
- +2 WRITE !!,"Copying monitor, please wait..."
- +3 SET QAMZERO=^QA(743,0)
- SET QAMS0=$PIECE(QAMZERO,"^",3)+1
- FOR QAMS0=QAMS0:1
- LOCK +^QA(743,QAMS0,0):0
- if $TEST&('$DATA(^QA(743,QAMS0,0)))
- QUIT
- LOCK -^QA(743,QAMS0,0):0
- +4 SET $PIECE(^QA(743,0),"^",3,4)=QAMS0_"^"_($PIECE(QAMZERO,"^",4)+1)
- +5 SET %X="^QA(743,"_QAMD0_","
- SET %Y="^QA(743,"_QAMS0_","
- LOCK -^QA(743,QAMS0,0):0
- DO %XY^%RCR
- SET DIK="^QA(743,"
- SET DA=QAMS0
- DO IX^DIK
- SET QAMD0=QAMS0
- EDIT KILL DR
- SET DIE="^QA(743,"
- SET DR=".01///"_QAMCODE_";.02///"_QAMTITLE_";7///UNDER CONSTRUCTION;54///OFF"
- SET DA=QAMD0
- DO ^DIE
- SET QAMFIN=0
- +1 WRITE !!,"You may now edit the copy of the monitor, please change the CODE and TITLE.",!
- DO EN2^QAMEDT0
- GOTO EN1
- EXIT ;
- +1 KILL %,%DT,%X,%Y,D0,D1,DA,DI,DIC,DIE,DIK,DQ,DR,J,QA,QAM,QAMAUTO,QAMCODE,QAMD0,QAMD1,QAMDFLT,QAMFIN,QAMPCODE,QAMS0,QAMTITLE,QAMZERO,X,Y
- +2 QUIT
