GMRVOREQ ;HIRMFO/MD,FT-QUICK ORDER PROTOCOL CREATION ;11/11/96 11:02
;;4.0;Vitals/Measurements;**2**;Apr 25, 1997
EN1 ; ENTRY TO CREATE QUICK ORDER PROTOCOL
S GMRVDEF="",GMRVOLD=0,DIC=101,DIC(0)="AEQS",D="C"
S DIC("S")="S GMRV=$P(^(0),U) I ""^GMRVORCG^GMRVORPO^GMRVORCVP^GMRVORTPR^GMRVORTPR B/P^GMRVORADMIT V/M^GMRVORPULSE^GMRVORB/P^GMRVORWT^GMRVORTEMP^GMRVORRESP^GMRVORHT^GMRVORPR B/P^GMRVORPB/P^""[(""^""_GMRV_""^"")!(GMRV[""GMRVORQ"")"
S DIC("A")="Select PROTOCOL to be added as a QUICK PROTOCOL: " D IX^DIC G QUIT:+Y'>0 S GMRVDA=+Y K GMRVPROT
I $S($D(^ORD(101,+Y,0))&($P(^(0),U)["GMRVORQ"):1,1:0) S GMRVOLD=1,GMRVDEF=$P(^(20),"""",2) G DEF
ASK S X=$P($G(^ORD(101,+Y,0)),"^",2) W !!,$C(7),"DO YOU WANT TO ADD "_X_" AS A QUICK ORDER PROTOCOL" S %=1 D YN^DICN W:'% !?4,"ANSWER YES OR NO." G ASK:'%,EN1:%=2,QUIT:%=-1
S %X="^ORD(101,"_+GMRVDA_",",%Y="GMRVPROT(" D %XY^%RCR
LOCK L +^GMRD(120.57,1,"Q0"):1
YNWAIT I '$T W !,$C(7),"SOMEONE ELSE IS ADDING QUICK ORDER PROTOCOLS,","WOULD YOU LIKE TO WAIT UNTIL THEY FINISH" S %=1 D YN^DICN W:'% !?4,"ANSWER YES OR NO." G YNWAIT:'%,LOCK:%=1,QUIT
S GMRVPNUM=+$P($G(^GMRD(120.57,1,"Q0")),"^") F GMRVPNUM=GMRVPNUM:1 S GMRVPNAM="GMRVORQ"_GMRVPNUM Q:'$O(^ORD(101,"B",GMRVPNAM))
DEF D SETUP I GMROUT L -^GMRD(120.57,1,"Q0") G QUIT
D:GMRVOLD=0 ADDNEW ;add a new entry to file 101
D:GMRVOLD=1 UPDATE ;update an existing entry in file 101
L -^GMRD(120.57,1,"Q0")
QUIT ;
K %,%DT,%X,%Y,D,DA,DIC,DIE,DIK,DIR,DLAYGO,DR,DUOUT,GMROUT,GMRV,GMRVANSR,GMRVAS,GMRVDA,GMRVDEF,GMRVDEL,GMRVDF,GMRVOAS,GMRVOLD,GMRVORD,GMRVPNAM,GMRVPNUM,GMRVPROT,GMRVQUES,GMRVSTRT,GMRVX,GMRVY,OREA,ORTX,TEXT,X,Y,Z,ZX,ZY
D ^%ZISC
Q
SETUP ; ASK USERS WHETHER TO ASK QUESTION OR STUFF ANSWER
;
; GMRVANSR=START^STOP^SCHEDULE^SPECIAL INSTRUCTIONS
; WHERE "" MEANS ASK NO DEFAULT
; VALUE MEANS ASK WITH DEFAULT OF VALUE
; ~VALUE MEANS NO ASK STUFF VALUE
;
W !!,"These are the Vital Measurement Quick Order Questions:",! F Y=1:1:4 W !,?3,Y_". ",$P($T(TEXT+Y),";",3)
I GMRVOLD=1 S GMRVANSR=GMRVDEF
S (GMRVDEL,GMROUT)=0,DIR("A")="Select the question(s) that require special action",DIR(0)="L^1:4",DIR("?")="Enter question selection(s)" D ^DIR I $D(DIRUT) S GMROUT=1 Q
I GMRVOLD=0,Y'[3 W !!,$C(7),"An Admin. Schedule is required for Vital Measurement Quick Order Protocols!" G SETUP
S GMRVX=0,(GMRVSTRT,GMRVY)="" K GMRVLIST
F Z=1:1 Q:$P(Y,",",Z)="" S GMRVLIST($P(Y,",",Z))=""
S (GMRVCNT,Z)=0
F S Z=$O(GMRVLIST(Z)) Q:Z'>0 S GMRVCNT=GMRVCNT+1,$P(GMRVY,",",GMRVCNT)=Z
K GMRVCNT,GMRVLIST
F Z(0)=1:1 S Z=$P(GMRVY,",",Z(0)) Q:Z'>0 D ASKDEF Q:GMROUT X $P($T(TEXT+Z),";",4) I $D(X),'+GMRVDEL S $P(GMRVANSR,"^",Z)=$S(+GMRVDEL:"",GMRVX=1:X,GMRVX=2:"~"_X,1:"") S:Z=1 GMRVSTRT=Y K GMRVX
I 'GMROUT S OREA="S GMRVANSR="""_GMRVANSR_""",GMRVKWIK=1 D DATE^GMRVOREQ Q:$S('$D(^ORD(100.99)):1,'$D(^PS(59.7,1,20)):1,1:^(20)<2.8) D EN1^GMRVORE0"
Q
DATE ; MAKE SURE THE DEFAULT ANSWERS ARE FM DATES
;
I $P(GMRVANSR,U)'="" S Z=$P(GMRVANSR,U),X=$S(Z?1"~".E:$P(Z,"~",2,999),1:Z),%DT="T" D ^%DT S $P(GMRVANSR,U)=$E("~",Z["~")_Y
I $P(GMRVANSR,U,2)'="" S Z=$P(GMRVANSR,U,2),X=$S(Z?1"~".E:$P(Z,"~",2,999),1:Z),%DT="T" D ^%DT S $P(GMRVANSR,U,2)=$E("~",Z["~")_Y
Q
SCH ;ADD SCHEDULE
S GMRVANSR=$S($D(GMRVANSR):GMRVANSR,1:""),ZY=$P(GMRVDEF,U,3),GMRVAS=$S(ZY'="":$P(ZY,"~",ZY["~"+1),1:$P(GMRVANSR,U,3)) D ADS^GMRVORC0
Q
ASKDEF ;
S GMRVQUES=$P($T(TEXT+Z),";",3) W !,"Choose one of the following:",!?5,"1. Ask "_GMRVQUES_"with a DEFAULT value",!,?5,"2. Automatically Enter "_GMRVQUES
W !,"Select 1 or 2: " R GMRVX:DTIME I "^"[GMRVX S GMROUT=1 Q
ASK1 I GMRVX'=1&(GMRVX'=2) W !!?5,$C(7),"Enter '1' to ask question with default value.",!?11,"'2' to not ask the question and automatically enter the default.",! G ASKDEF
I '(Z=3) S ZX=$P(GMRVDEF,U,Z) W !,"Enter default value: "_$S(ZX'="":$P(ZX,"~",ZX["~"+1)_"// ",1:"") R X:DTIME I '(Z>2),X["?" S %DT="ET",%DT(0)=$S(Z=1:"N",1:$P(GMRVSTRT,"~",GMRVSTRT["~"+1)) D HELP^%DTC
G:X["?" ASK1 I X="^"!(X=""&($G(ZX)="")) S GMROUT=1
I X="" S X=$P(ZX,"~",ZX["~"+1)
I X="@" S GMRVDEL=1
Q
TEXT ;
;;START/Date ;Q:X="@" S %DT="ET",%DT(0)=DT D ^%DT I Y<1 K X D HELP^%DTC S Z(0)=Z(0)-1
;;STOP/Date ;Q:X="@" S %DT="ET",%DT(0)=$P(GMRVSTRT,"~",GMRVSTRT["~"+1) K:'$L(%DT(0)) %DT(0) D ^%DT I Y<1 K X D HELP^%DTC S Z(0)=Z(0)-1
;;Administrative Schedule ;D SCH
;;Special Instructions ;Q:X="@" I $L(X)<3!($L(X)>100) K X W *7,!,"Answer must be 3-100 characters in length" S Z(0)=Z(0)-1
Q
;
UPDATE ; update existing entry
S GMRVOAS=$P(^ORD(101,+GMRVDA,20),""",GMRVKWIK") ;get old Admin Schedule
S GMRVOAS=$P(GMRVOAS,"^",3) S:GMRVOAS["~" GMRVOAS=$P(GMRVOAS,"~",2)
S GMRVAS=$S($E($P(GMRVANSR,"^",3))="~":$E($P(GMRVANSR,"^",3),2,99),1:$P(GMRVANSR,"^",3)) ;get new Admin Schedule
I GMRVAS]"",GMRVOAS'=GMRVAS W !!,"You changed the Administration Schedule to ",GMRVAS,!,"You should edit the ITEM TEXT.",!
IT0 ; item text
K DIR S DIR(0)="101,1",(GMRVDIRB,DIR("B"))=$P(^ORD(101,+GMRVDA,0),U,2)
D ^DIR
Q:$D(DIRUT)
I GMRVDIRB'=Y,$D(^ORD(101,"C",Y)) W !!,$C(7),"A Quick Order Protocol with an ITEM TEXT of ",!,Y," already exists.",!,"Please edit the ITEM TEXT value to make it unique.",!! G IT0
S GMRVPROT("QUICK TEXT")=Y
S DIE="^ORD(101,",DA=+GMRVDA,DR="1///"_GMRVPROT("QUICK TEXT")_";20////^S X=OREA" D ^DIE ;stuff item text and entry action
Q
ADDNEW ; add new entry
S GMRVPROT("QUICK TEXT")="QUICK "_$S($E($P(GMRVANSR,"^",3))="~":$E($P(GMRVANSR,"^",3),2,99),1:$P(GMRVANSR,"^",3))_" "_$S($P($G(GMRVPROT(0)),"^",2)'="":$P(GMRVPROT(0),"^",2),1:"")
K DIR S DIR(0)="101,1",DIR("B")=GMRVPROT("QUICK TEXT") D ^DIR
Q:$D(DIRUT)
S GMRVPROT("QUICK TEXT")=Y
I $D(^ORD(101,"C",GMRVPROT("QUICK TEXT"))) W !!,$C(7),"A Quick Order Protocol with an ITEM TEXT of ",!,GMRVPROT("QUICK TEXT")," already exists.",!,"Please edit the ITEM TEXT value to make it unique.",!! G ADDNEW
S $P(GMRVPROT(0),"^",1,2)=GMRVPNAM_"^"_GMRVPROT("QUICK TEXT"),$P(GMRVPROT(0),"^",5)=DUZ,GMRVPROT(20)=OREA,$P(GMRVPROT(99),"^")=$H
S DLAYGO=101,X=GMRVPNAM,DIC="^ORD(101,",DIC(0)="LQ" K DD D FILE^DICN G QUIT:+Y'>0 S %Y="^ORD(101,"_+Y_",",%X="GMRVPROT(" D %XY^%RCR S DA=+Y,DIK="^ORD(101," D IX1^DIK
S $P(^GMRD(120.57,1,"Q0"),"^")=GMRVPNUM+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRVOREQ 6270 printed Oct 16, 2024@17:58:02 Page 2
GMRVOREQ ;HIRMFO/MD,FT-QUICK ORDER PROTOCOL CREATION ;11/11/96 11:02
+1 ;;4.0;Vitals/Measurements;**2**;Apr 25, 1997
EN1 ; ENTRY TO CREATE QUICK ORDER PROTOCOL
+1 SET GMRVDEF=""
SET GMRVOLD=0
SET DIC=101
SET DIC(0)="AEQS"
SET D="C"
+2 SET DIC("S")="S GMRV=$P(^(0),U) I ""^GMRVORCG^GMRVORPO^GMRVORCVP^GMRVORTPR^GMRVORTPR B/P^GMRVORADMIT V/M^GMRVORPULSE^GMRVORB/P^GMRVORWT^GMRVORTEMP^GMRVORRESP^GMRVORHT^GMRVORPR B/P^GMRVORPB/P^""[(""^""_GMRV_""^"")!(GMRV[""GMRVORQ"")"
+3 SET DIC("A")="Select PROTOCOL to be added as a QUICK PROTOCOL: "
DO IX^DIC
if +Y'>0
GOTO QUIT
SET GMRVDA=+Y
KILL GMRVPROT
+4 IF $SELECT($DATA(^ORD(101,+Y,0))&($PIECE(^(0),U)["GMRVORQ"):1,1:0)
SET GMRVOLD=1
SET GMRVDEF=$PIECE(^(20),"""",2)
GOTO DEF
ASK SET X=$PIECE($GET(^ORD(101,+Y,0)),"^",2)
WRITE !!,$CHAR(7),"DO YOU WANT TO ADD "_X_" AS A QUICK ORDER PROTOCOL"
SET %=1
DO YN^DICN
if '%
WRITE !?4,"ANSWER YES OR NO."
if '%
GOTO ASK
if %=2
GOTO EN1
if %=-1
GOTO QUIT
+1 SET %X="^ORD(101,"_+GMRVDA_","
SET %Y="GMRVPROT("
DO %XY^%RCR
LOCK LOCK +^GMRD(120.57,1,"Q0"):1
YNWAIT IF '$TEST
WRITE !,$CHAR(7),"SOMEONE ELSE IS ADDING QUICK ORDER PROTOCOLS,","WOULD YOU LIKE TO WAIT UNTIL THEY FINISH"
SET %=1
DO YN^DICN
if '%
WRITE !?4,"ANSWER YES OR NO."
if '%
GOTO YNWAIT
if %=1
GOTO LOCK
GOTO QUIT
+1 SET GMRVPNUM=+$PIECE($GET(^GMRD(120.57,1,"Q0")),"^")
FOR GMRVPNUM=GMRVPNUM:1
SET GMRVPNAM="GMRVORQ"_GMRVPNUM
if '$ORDER(^ORD(101,"B",GMRVPNAM))
QUIT
DEF DO SETUP
IF GMROUT
LOCK -^GMRD(120.57,1,"Q0")
GOTO QUIT
+1 ;add a new entry to file 101
if GMRVOLD=0
DO ADDNEW
+2 ;update an existing entry in file 101
if GMRVOLD=1
DO UPDATE
+3 LOCK -^GMRD(120.57,1,"Q0")
QUIT ;
+1 KILL %,%DT,%X,%Y,D,DA,DIC,DIE,DIK,DIR,DLAYGO,DR,DUOUT,GMROUT,GMRV,GMRVANSR,GMRVAS,GMRVDA,GMRVDEF,GMRVDEL,GMRVDF,GMRVOAS,GMRVOLD,GMRVORD,GMRVPNAM,GMRVPNUM,GMRVPROT,GMRVQUES,GMRVSTRT,GMRVX,GMRVY,OREA,ORTX,TEXT,X,Y,Z,ZX,ZY
+2 DO ^%ZISC
+3 QUIT
SETUP ; ASK USERS WHETHER TO ASK QUESTION OR STUFF ANSWER
+1 ;
+2 ; GMRVANSR=START^STOP^SCHEDULE^SPECIAL INSTRUCTIONS
+3 ; WHERE "" MEANS ASK NO DEFAULT
+4 ; VALUE MEANS ASK WITH DEFAULT OF VALUE
+5 ; ~VALUE MEANS NO ASK STUFF VALUE
+6 ;
+7 WRITE !!,"These are the Vital Measurement Quick Order Questions:",!
FOR Y=1:1:4
WRITE !,?3,Y_". ",$PIECE($TEXT(TEXT+Y),";",3)
+8 IF GMRVOLD=1
SET GMRVANSR=GMRVDEF
+9 SET (GMRVDEL,GMROUT)=0
SET DIR("A")="Select the question(s) that require special action"
SET DIR(0)="L^1:4"
SET DIR("?")="Enter question selection(s)"
DO ^DIR
IF $DATA(DIRUT)
SET GMROUT=1
QUIT
+10 IF GMRVOLD=0
IF Y'[3
WRITE !!,$CHAR(7),"An Admin. Schedule is required for Vital Measurement Quick Order Protocols!"
GOTO SETUP
+11 SET GMRVX=0
SET (GMRVSTRT,GMRVY)=""
KILL GMRVLIST
+12 FOR Z=1:1
if $PIECE(Y,",",Z)=""
QUIT
SET GMRVLIST($PIECE(Y,",",Z))=""
+13 SET (GMRVCNT,Z)=0
+14 FOR
SET Z=$ORDER(GMRVLIST(Z))
if Z'>0
QUIT
SET GMRVCNT=GMRVCNT+1
SET $PIECE(GMRVY,",",GMRVCNT)=Z
+15 KILL GMRVCNT,GMRVLIST
+16 FOR Z(0)=1:1
SET Z=$PIECE(GMRVY,",",Z(0))
if Z'>0
QUIT
DO ASKDEF
if GMROUT
QUIT
XECUTE $PIECE($TEXT(TEXT+Z),";",4)
IF $DATA(X)
IF '+GMRVDEL
SET $PIECE(GMRVANSR,"^",Z)=$SELECT(+GMRVDEL:"",GMRVX=1:X,GMRVX=2:"~"_X,1:"")
if Z=1
SET GMRVSTRT=Y
KILL GMRVX
+17 IF 'GMROUT
SET OREA="S GMRVANSR="""_GMRVANSR_""",GMRVKWIK=1 D DATE^GMRVOREQ Q:$S('$D(^ORD(100.99)):1,'$D(^PS(59.7,1,20)):1,1:^(20)<2.8) D EN1^GMRVORE0"
+18 QUIT
DATE ; MAKE SURE THE DEFAULT ANSWERS ARE FM DATES
+1 ;
+2 IF $PIECE(GMRVANSR,U)'=""
SET Z=$PIECE(GMRVANSR,U)
SET X=$SELECT(Z?1"~".E:$PIECE(Z,"~",2,999),1:Z)
SET %DT="T"
DO ^%DT
SET $PIECE(GMRVANSR,U)=$EXTRACT("~",Z["~")_Y
+3 IF $PIECE(GMRVANSR,U,2)'=""
SET Z=$PIECE(GMRVANSR,U,2)
SET X=$SELECT(Z?1"~".E:$PIECE(Z,"~",2,999),1:Z)
SET %DT="T"
DO ^%DT
SET $PIECE(GMRVANSR,U,2)=$EXTRACT("~",Z["~")_Y
+4 QUIT
SCH ;ADD SCHEDULE
+1 SET GMRVANSR=$SELECT($DATA(GMRVANSR):GMRVANSR,1:"")
SET ZY=$PIECE(GMRVDEF,U,3)
SET GMRVAS=$SELECT(ZY'="":$PIECE(ZY,"~",ZY["~"+1),1:$PIECE(GMRVANSR,U,3))
DO ADS^GMRVORC0
+2 QUIT
ASKDEF ;
+1 SET GMRVQUES=$PIECE($TEXT(TEXT+Z),";",3)
WRITE !,"Choose one of the following:",!?5,"1. Ask "_GMRVQUES_"with a DEFAULT value",!,?5,"2. Automatically Enter "_GMRVQUES
+2 WRITE !,"Select 1 or 2: "
READ GMRVX:DTIME
IF "^"[GMRVX
SET GMROUT=1
QUIT
ASK1 IF GMRVX'=1&(GMRVX'=2)
WRITE !!?5,$CHAR(7),"Enter '1' to ask question with default value.",!?11,"'2' to not ask the question and automatically enter the default.",!
GOTO ASKDEF
+1 IF '(Z=3)
SET ZX=$PIECE(GMRVDEF,U,Z)
WRITE !,"Enter default value: "_$SELECT(ZX'="":$PIECE(ZX,"~",ZX["~"+1)_"// ",1:"")
READ X:DTIME
IF '(Z>2)
IF X["?"
SET %DT="ET"
SET %DT(0)=$SELECT(Z=1:"N",1:$PIECE(GMRVSTRT,"~",GMRVSTRT["~"+1))
DO HELP^%DTC
+2 if X["?"
GOTO ASK1
IF X="^"!(X=""&($GET(ZX)=""))
SET GMROUT=1
+3 IF X=""
SET X=$PIECE(ZX,"~",ZX["~"+1)
+4 IF X="@"
SET GMRVDEL=1
+5 QUIT
TEXT ;
+1 ;;START/Date ;Q:X="@" S %DT="ET",%DT(0)=DT D ^%DT I Y<1 K X D HELP^%DTC S Z(0)=Z(0)-1
+2 ;;STOP/Date ;Q:X="@" S %DT="ET",%DT(0)=$P(GMRVSTRT,"~",GMRVSTRT["~"+1) K:'$L(%DT(0)) %DT(0) D ^%DT I Y<1 K X D HELP^%DTC S Z(0)=Z(0)-1
+3 ;;Administrative Schedule ;D SCH
+4 ;;Special Instructions ;Q:X="@" I $L(X)<3!($L(X)>100) K X W *7,!,"Answer must be 3-100 characters in length" S Z(0)=Z(0)-1
+5 QUIT
+6 ;
UPDATE ; update existing entry
+1 ;get old Admin Schedule
SET GMRVOAS=$PIECE(^ORD(101,+GMRVDA,20),""",GMRVKWIK")
+2 SET GMRVOAS=$PIECE(GMRVOAS,"^",3)
if GMRVOAS["~"
SET GMRVOAS=$PIECE(GMRVOAS,"~",2)
+3 ;get new Admin Schedule
SET GMRVAS=$SELECT($EXTRACT($PIECE(GMRVANSR,"^",3))="~":$EXTRACT($PIECE(GMRVANSR,"^",3),2,99),1:$PIECE(GMRVANSR,"^",3))
+4 IF GMRVAS]""
IF GMRVOAS'=GMRVAS
WRITE !!,"You changed the Administration Schedule to ",GMRVAS,!,"You should edit the ITEM TEXT.",!
IT0 ; item text
+1 KILL DIR
SET DIR(0)="101,1"
SET (GMRVDIRB,DIR("B"))=$PIECE(^ORD(101,+GMRVDA,0),U,2)
+2 DO ^DIR
+3 if $DATA(DIRUT)
QUIT
+4 IF GMRVDIRB'=Y
IF $DATA(^ORD(101,"C",Y))
WRITE !!,$CHAR(7),"A Quick Order Protocol with an ITEM TEXT of ",!,Y," already exists.",!,"Please edit the ITEM TEXT value to make it unique.",!!
GOTO IT0
+5 SET GMRVPROT("QUICK TEXT")=Y
+6 ;stuff item text and entry action
SET DIE="^ORD(101,"
SET DA=+GMRVDA
SET DR="1///"_GMRVPROT("QUICK TEXT")_";20////^S X=OREA"
DO ^DIE
+7 QUIT
ADDNEW ; add new entry
+1 SET GMRVPROT("QUICK TEXT")="QUICK "_$SELECT($EXTRACT($PIECE(GMRVANSR,"^",3))="~":$EXTRACT($PIECE(GMRVANSR,"^",3),2,99),1:$PIECE(GMRVANSR,"^",3))_" "_$SELECT($PIECE($GET(GMRVPROT(0)),"^",2)'="":$PIECE(GMRVPROT(0),"^",2),1:"")
+2 KILL DIR
SET DIR(0)="101,1"
SET DIR("B")=GMRVPROT("QUICK TEXT")
DO ^DIR
+3 if $DATA(DIRUT)
QUIT
+4 SET GMRVPROT("QUICK TEXT")=Y
+5 IF $DATA(^ORD(101,"C",GMRVPROT("QUICK TEXT")))
WRITE !!,$CHAR(7),"A Quick Order Protocol with an ITEM TEXT of ",!,GMRVPROT("QUICK TEXT")," already exists.",!,"Please edit the ITEM TEXT value to make it unique.",!!
GOTO ADDNEW
+6 SET $PIECE(GMRVPROT(0),"^",1,2)=GMRVPNAM_"^"_GMRVPROT("QUICK TEXT")
SET $PIECE(GMRVPROT(0),"^",5)=DUZ
SET GMRVPROT(20)=OREA
SET $PIECE(GMRVPROT(99),"^")=$HOROLOG
+7 SET DLAYGO=101
SET X=GMRVPNAM
SET DIC="^ORD(101,"
SET DIC(0)="LQ"
KILL DD
DO FILE^DICN
if +Y'>0
GOTO QUIT
SET %Y="^ORD(101,"_+Y_","
SET %X="GMRVPROT("
DO %XY^%RCR
SET DA=+Y
SET DIK="^ORD(101,"
DO IX1^DIK
+8 SET $PIECE(^GMRD(120.57,1,"Q0"),"^")=GMRVPNUM+1
+9 QUIT
