GMRYUT5 ;HIRMFO/YH-UTILITIES FOR IV INPUT/OUTPUT TRANSFORM ;5/13/96
;;4.0;Intake/Output;;Apr 25, 1997
EN1 ;INFUSION SITE EXECUTABLE HELP, CALLED BY DD
I '$D(GMRTRNS) D
. N MSG S MSG(1)="Select from the following IV sites",MSG(2)=" "
. D EN^DDIOL(.MSG)
. Q
S:'$D(GMRTRNS) X="" S (GMRZ,GMRN)=0 F S GMRZ=$O(^GMRD(126.7,GMRZ)) Q:GMRZ'>0 S GMRN=GMRN+1,GMRY(GMRN)=GMRZ_"^"_$P(^(GMRZ,0),"^")_"^"_GMRN_". "
S GMRN(1)=(GMRN\2)+(GMRN#2)
I '$D(GMRTRNS) D LISTS
I $D(GMRTRNS) K GTXT Q
S MSG(1)=" ",MSG(2)="Enter a number with a qualifier L for LEFT/R for RIGHT, default (L)eft.",MSG(3)="(e.g., 2R for RIGHT WRIST; 2 or 2L for LEFT WRIST)" D EN^DDIOL(.MSG)
K MSG K:'$D(GMRTRNS) GMRY,GMRZ,GMRN,GTXT Q
EN2 ;INFUSION SITE INPUT TRANSFORM, CALLED BY DD
N GMROUT S:X["^" X="" G:X=""!($L(X)>3) Q K GMRX S GMROUT=0,GMRX=+X S:GMRX'>0 X="" G:X="" Q S GMRX(1)=$E(X,$L(X)),GMRTRNS=1,X="" D EN1
I GMRX>0 D
.I $G(GMRY(+GMRX))["OTHER" D OSITE^GMRYUT12 Q
.I $D(GMRY(+GMRX)) S X=$S(GMRX(1)="":"LEFT","Rr"[GMRX(1):"RIGHT",1:"LEFT")_" "_$P(GMRY(GMRX),"^",2)
E D SELSITE^GMRYUT7 Q:GMROUT S:X'="" X=$S(GMRX(1)="":"LEFT","Rr"[GMRX(1):"RIGHT",1:"LEFT")_" "_X
I X'="" D EN^DDIOL(" "_X)
K GMRX,GMRY,GMRZ,GMRN,GMRTRNS Q
Q K GMRX,GMRY,GMRN,GMRTRNS,GTXT Q
EN3 ;COMPUTE IV INTAKE AMOUNT, CALLED BY DD FOR COMPUTE FIELD
S GTOTAL=+$P(^GMR(126,D0,"IV",D1,0),"^",5)
K GMRY S GMRX=0 F S GMRX=$O(^GMR(126,D0,"IV",D1,"IN","B",GMRX)) Q:GMRX'>0 S GMRX(1)=0 F S GMRX(1)=$O(^(GMRX,GMRX(1))) Q:GMRX(1)'>0 D SETARY
S X=+$P(GMRY($P(^GMR(126,D0,"IV",D1,"IN",D2,0),"^"),+D2),"^",2)
Q
SETARY S GLEFT=+$P(^GMR(126,D0,"IV",D1,"IN",GMRX(1),0),"^",2),GINTAKE=$S($E($P(^(0),"^",2))="*":0,1:GTOTAL-GLEFT),GTOTAL=GTOTAL-GINTAKE,GMRY(GMRX,GMRX(1))=GLEFT_"^"_GINTAKE
Q
EN4 ;SET SITE DC, TUBE CHANGE AND DRESSING CHANGE
S:'$D(GDR) GDR=0 I '$D(^GMR(126,DA(1),"IVM",DA,1,0)) S ^GMR(126,DA(1),"IVM",DA,1,0)="^126.41DA^0^0"
D WAIT^GMRYUT0 Q:GMROUT K DD S DA(2)=DA(1),DA(1)=DA,X=+GX,DIC="^GMR(126,"_DA(2)_",""IVM"","_DA(1)_",1,",DIC(0)="ML" D FILE^DICN L -^GMR(126,DFN) Q:+Y'>0 S DA=+Y
K DD,DIC S DIE="^GMR(126,"_DA(2)_",""IVM"","_DA(1)_",1,"
G:'$D(GOPT) NOGOPT
I GOPT["SITECK" D:$P(^GMR(126,DA(2),"IVM",DA(1),1,DA,0),"^",2)="" SITEDES^GMRYUT6 D SITEDC^GMRYUT7 D KILLRC^GMRYUT9:GMRZ=""!GMROUT,ADDRC^GMRYUT9:GMRZ'="" K GMRZ,DIC G Q2
I GOPT["START"!(GOPT["ADDONLY")!(GOPT["RESTART") S DR="S:GMRVTYP=""P""!(GDR=2) Y=""@1"";1////^S X=""NO REDNESS/PAIN/SWELLING"";@1;2///^S X=""yes"";S:GMRVTYP[""P""!(GDR>1) Y=""@2"";3///^S X=""yes"";@2;4///^S X=""`""_DUZ;6///^S X=GLINE" G Q1
I GOPT["DCIV" D SITEDES^GMRYUT6 S DR="1///^S X=GMRZ;2///^S X=""no"";3///;4///^S X=""`""_DUZ;5///^S X=""yes"";" G Q1
I GOPT["ADDSOL"!(GOPT["HANG") D:$P(^GMR(126,DA(2),"IVM",DA(1),1,DA,0),"^",2)=""&(GMRVTYP'["P") SITEDES^GMRYUT6 D ADDHNG^GMRYUT6 G Q1
NOGOPT D:$P(^GMR(126,DA(2),"IVM",DA(1),1,DA,0),"^",2)="" SITEDES^GMRYUT6 S DR="S:GMRVTYP[""P"" Y=""@1"";1///^S X=GMRZ;@1;2//^S X=""N"";S:GMRVTYP[""P"" Y=""@2"";3;@2;4///^S X=""`""_DUZ;5;" G Q1
G Q2
Q1 D WAIT^GMRYUT0 G:GMROUT Q2
D ^DIE L -^GMR(126,DFN) I $P(^GMR(126,DA(2),"IVM",DA(1),1,DA,0),"^",2)="",$P(^(0),"^",3)="",$P(^(0),"^",4)="",$P(^(0),"^",6)="" D KILLRC^GMRYUT9
I $D(^GMR(126,DA(2),"IVM",DA(1),1,DA,0)),$P(^(0),"^",3)["Y",$P(^(0),"^",7)="" D IVLINE^GMRYUT9 D:GMROUT KILLRC^GMRYUT9
Q2 K DIE,DR,GMRZ Q
LISTS ;DISPLAY SITES
K GTXT F I=1:1:GMRN(1) S $P(GTXT(I)," ",80)="" I $D(GMRY(I)) S GMRY=$P(GMRY(I),"^",3)_$P(GMRY(I),"^",2),GTXT(I)=GMRY_$E(GTXT(I),$L(GMRY),80)
F I=GMRN(1)+1:1:GMRN I $D(GMRY(I)) S GTXT(I-GMRN(1))=$E(GTXT(I-GMRN(1)),1,40)_$P(GMRY(I),"^",3)_$P(GMRY(I),"^",2)
N MSSG F I=1:1:GMRN(1) S MSSG=GTXT(I) D EN^DDIOL(MSSG)
Q
SITEDES ;CALLED BY DD TO DISPLAY SELECTIONS FOR SITE DESCRIPTION
S GMRTRNS=0
DISPLAY N MSG K GMRZ S GMRZ="" I '$D(GMRTRNS) S MSG(1)=" ",MSG(2)="IV site descriptions" D EN^DDIOL(.MSG)
K GMRY S GMRY=0,GMRN=0 F S GMRY=$O(^GMRD(126.72,GMRY)) Q:GMRY'>0 S GMRN=GMRN+1,GMRY(GMRN)=GMRY_"^"_$P(^GMRD(126.72,+GMRY,0),"^") I GMRTRNS'=1 S MSG(1)=GMRN_". "_$P(GMRY(GMRN),"^",2) D EN^DDIOL(.MSG)
I GMRN'>0 K GMRX,GMRY,GMRN,GMRTRNS Q
Q:GMRTRNS=1 S MSG(1)="Select from 1 to "_GMRN_" (enter 1,3-5 etc.) to describe the infusion site: " D EN^DDIOL(.MSG) K:GMRTRNS=0 GMRY,GMRX,GMRZ,GMRTRNS Q
SITEDES1 ;SITE DESCRIPTION INPUT TRANSFORM, CALLED BY DD
G:X=""!(+X'>0) QL K GMRX S GMRX=X,GMRTRNS=1 D DISPLAY
S X="" D VALIDAT^GMRYUT9 G:'$D(GSEL) QL S GMRX=0 F S GMRX=$O(GSEL(GMRX)) Q:GMRX'>0 S X=X_$S($L(X)>0:", ",1:"")_$P(GMRY(GMRX),"^",2)
QL D:X'="" EN^DDIOL(" "_X) K GMRX,GMRY,GMRN,GMRTRNS,GMRZ,GSEL Q
GMRYUT5 ;HIRMFO/YH-UTILITIES FOR IV INPUT/OUTPUT TRANSFORM ;5/13/96
+1 ;;4.0;Intake/Output;;Apr 25, 1997
EN1 ;INFUSION SITE EXECUTABLE HELP, CALLED BY DD
+1 IF '$DATA(GMRTRNS)
Begin DoDot:1
+2 NEW MSG
SET MSG(1)="Select from the following IV sites"
SET MSG(2)=" "
+3 DO EN^DDIOL(.MSG)
+4 QUIT
End DoDot:1
+5 IF '$DATA(GMRTRNS)
SET X=""
SET (GMRZ,GMRN)=0
FOR
SET GMRZ=$ORDER(^GMRD(126.7,GMRZ))
IF GMRZ'>0
QUIT
SET GMRN=GMRN+1
SET GMRY(GMRN)=GMRZ_"^"_$PIECE(^(GMRZ,0),"^")_"^"_GMRN_". "
+6 SET GMRN(1)=(GMRN\2)+(GMRN#2)
+7 IF '$DATA(GMRTRNS)
DO LISTS
+8 IF $DATA(GMRTRNS)
KILL GTXT
QUIT
+9 SET MSG(1)=" "
SET MSG(2)="Enter a number with a qualifier L for LEFT/R for RIGHT, default (L)eft."
SET MSG(3)="(e.g., 2R for RIGHT WRIST; 2 or 2L for LEFT WRIST)"
DO EN^DDIOL(.MSG)
+10 KILL MSG
IF '$DATA(GMRTRNS)
KILL GMRY,GMRZ,GMRN,GTXT
QUIT
EN2 ;INFUSION SITE INPUT TRANSFORM, CALLED BY DD
+1 NEW GMROUT
IF X["^"
SET X=""
IF X=""!($LENGTH(X)>3)
GOTO Q
KILL GMRX
SET GMROUT=0
SET GMRX=+X
IF GMRX'>0
SET X=""
IF X=""
GOTO Q
SET GMRX(1)=$EXTRACT(X,$LENGTH(X))
SET GMRTRNS=1
SET X=""
DO EN1
+2 IF GMRX>0
Begin DoDot:1
+3 IF $GET(GMRY(+GMRX))["OTHER"
DO OSITE^GMRYUT12
QUIT
+4 IF $DATA(GMRY(+GMRX))
SET X=$SELECT(GMRX(1)="":"LEFT","Rr"[GMRX(1):"RIGHT",1:"LEFT")_" "_$PIECE(GMRY(GMRX),"^",2)
End DoDot:1
+5 IF '$TEST
DO SELSITE^GMRYUT7
IF GMROUT
QUIT
IF X'=""
SET X=$SELECT(GMRX(1)="":"LEFT","Rr"[GMRX(1):"RIGHT",1:"LEFT")_" "_X
+6 IF X'=""
DO EN^DDIOL(" "_X)
+7 KILL GMRX,GMRY,GMRZ,GMRN,GMRTRNS
QUIT
Q KILL GMRX,GMRY,GMRN,GMRTRNS,GTXT
QUIT
EN3 ;COMPUTE IV INTAKE AMOUNT, CALLED BY DD FOR COMPUTE FIELD
+1 SET GTOTAL=+$PIECE(^GMR(126,D0,"IV",D1,0),"^",5)
+2 KILL GMRY
SET GMRX=0
FOR
SET GMRX=$ORDER(^GMR(126,D0,"IV",D1,"IN","B",GMRX))
IF GMRX'>0
QUIT
SET GMRX(1)=0
FOR
SET GMRX(1)=$ORDER(^(GMRX,GMRX(1)))
IF GMRX(1)'>0
QUIT
DO SETARY
+3 SET X=+$PIECE(GMRY($PIECE(^GMR(126,D0,"IV",D1,"IN",D2,0),"^"),+D2),"^",2)
+4 QUIT
SETARY SET GLEFT=+$PIECE(^GMR(126,D0,"IV",D1,"IN",GMRX(1),0),"^",2)
SET GINTAKE=$SELECT($EXTRACT($PIECE(^(0),"^",2))="*":0,1:GTOTAL-GLEFT)
SET GTOTAL=GTOTAL-GINTAKE
SET GMRY(GMRX,GMRX(1))=GLEFT_"^"_GINTAKE
+1 QUIT
EN4 ;SET SITE DC, TUBE CHANGE AND DRESSING CHANGE
+1 IF '$DATA(GDR)
SET GDR=0
IF '$DATA(^GMR(126,DA(1),"IVM",DA,1,0))
SET ^GMR(126,DA(1),"IVM",DA,1,0)="^126.41DA^0^0"
+2 DO WAIT^GMRYUT0
IF GMROUT
QUIT
KILL DD
SET DA(2)=DA(1)
SET DA(1)=DA
SET X=+GX
SET DIC="^GMR(126,"_DA(2)_",""IVM"","_DA(1)_",1,"
SET DIC(0)="ML"
DO FILE^DICN
LOCK -^GMR(126,DFN)
IF +Y'>0
QUIT
SET DA=+Y
+3 KILL DD,DIC
SET DIE="^GMR(126,"_DA(2)_",""IVM"","_DA(1)_",1,"
+4 IF '$DATA(GOPT)
GOTO NOGOPT
+5 IF GOPT["SITECK"
IF $PIECE(^GMR(126,DA(2),"IVM",DA(1),1,DA,0),"^",2)=""
DO SITEDES^GMRYUT6
DO SITEDC^GMRYUT7
IF GMRZ=""!GMROUT
DO KILLRC^GMRYUT9
IF GMRZ'=""
DO ADDRC^GMRYUT9
KILL GMRZ,DIC
GOTO Q2
+6 IF GOPT["START"!(GOPT["ADDONLY")!(GOPT["RESTART")
SET DR="S:GMRVTYP=""P""!(GDR=2) Y=""@1"";1////^S X=""NO REDNESS/PAIN/SWELLING"";@1;2///^S X=""yes"";S:GMRVTYP[""P""!(GDR>1) Y=""@2"";3///^S X=""yes"";@2;4///^S X=""`""_DUZ;6///^S X=GLINE"
GOTO Q1
+7 IF GOPT["DCIV"
DO SITEDES^GMRYUT6
SET DR="1///^S X=GMRZ;2///^S X=""no"";3///;4///^S X=""`""_DUZ;5///^S X=""yes"";"
GOTO Q1
+8 IF GOPT["ADDSOL"!(GOPT["HANG")
IF $PIECE(^GMR(126,DA(2),"IVM",DA(1),1,DA,0),"^",2)=""&(GMRVTYP'["P")
DO SITEDES^GMRYUT6
DO ADDHNG^GMRYUT6
GOTO Q1
NOGOPT IF $PIECE(^GMR(126,DA(2),"IVM",DA(1),1,DA,0),"^",2)=""
DO SITEDES^GMRYUT6
SET DR="S:GMRVTYP[""P"" Y=""@1"";1///^S X=GMRZ;@1;2//^S X=""N"";S:GMRVTYP[""P"" Y=""@2"";3;@2;4///^S X=""`""_DUZ;5;"
GOTO Q1
+1 GOTO Q2
Q1 DO WAIT^GMRYUT0
IF GMROUT
GOTO Q2
+1 DO ^DIE
LOCK -^GMR(126,DFN)
IF $PIECE(^GMR(126,DA(2),"IVM",DA(1),1,DA,0),"^",2)=""
IF $PIECE(^(0),"^",3)=""
IF $PIECE(^(0),"^",4)=""
IF $PIECE(^(0),"^",6)=""
DO KILLRC^GMRYUT9
+2 IF $DATA(^GMR(126,DA(2),"IVM",DA(1),1,DA,0))
IF $PIECE(^(0),"^",3)["Y"
IF $PIECE(^(0),"^",7)=""
DO IVLINE^GMRYUT9
IF GMROUT
DO KILLRC^GMRYUT9
Q2 KILL DIE,DR,GMRZ
QUIT
LISTS ;DISPLAY SITES
+1 KILL GTXT
FOR I=1:1:GMRN(1)
SET $PIECE(GTXT(I)," ",80)=""
IF $DATA(GMRY(I))
SET GMRY=$PIECE(GMRY(I),"^",3)_$PIECE(GMRY(I),"^",2)
SET GTXT(I)=GMRY_$EXTRACT(GTXT(I),$LENGTH(GMRY),80)
+2 FOR I=GMRN(1)+1:1:GMRN
IF $DATA(GMRY(I))
SET GTXT(I-GMRN(1))=$EXTRACT(GTXT(I-GMRN(1)),1,40)_$PIECE(GMRY(I),"^",3)_$PIECE(GMRY(I),"^",2)
+3 NEW MSSG
FOR I=1:1:GMRN(1)
SET MSSG=GTXT(I)
DO EN^DDIOL(MSSG)
+4 QUIT
SITEDES ;CALLED BY DD TO DISPLAY SELECTIONS FOR SITE DESCRIPTION
+1 SET GMRTRNS=0
DISPLAY NEW MSG
KILL GMRZ
SET GMRZ=""
IF '$DATA(GMRTRNS)
SET MSG(1)=" "
SET MSG(2)="IV site descriptions"
DO EN^DDIOL(.MSG)
+1 KILL GMRY
SET GMRY=0
SET GMRN=0
FOR
SET GMRY=$ORDER(^GMRD(126.72,GMRY))
IF GMRY'>0
QUIT
SET GMRN=GMRN+1
SET GMRY(GMRN)=GMRY_"^"_$PIECE(^GMRD(126.72,+GMRY,0),"^")
IF GMRTRNS'=1
SET MSG(1)=GMRN_". "_$PIECE(GMRY(GMRN),"^",2)
DO EN^DDIOL(.MSG)
+2 IF GMRN'>0
KILL GMRX,GMRY,GMRN,GMRTRNS
QUIT
+3 IF GMRTRNS=1
QUIT
SET MSG(1)="Select from 1 to "_GMRN_" (enter 1,3-5 etc.) to describe the infusion site: "
DO EN^DDIOL(.MSG)
IF GMRTRNS=0
KILL GMRY,GMRX,GMRZ,GMRTRNS
QUIT
SITEDES1 ;SITE DESCRIPTION INPUT TRANSFORM, CALLED BY DD
+1 IF X=""!(+X'>0)
GOTO QL
KILL GMRX
SET GMRX=X
SET GMRTRNS=1
DO DISPLAY
+2 SET X=""
DO VALIDAT^GMRYUT9
IF '$DATA(GSEL)
GOTO QL
SET GMRX=0
FOR
SET GMRX=$ORDER(GSEL(GMRX))
IF GMRX'>0
QUIT
SET X=X_$SELECT($LENGTH(X)>0:", ",1:"")_$PIECE(GMRY(GMRX),"^",2)
QL IF X'=""
DO EN^DDIOL(" "_X)
KILL GMRX,GMRY,GMRN,GMRTRNS,GMRZ,GSEL
QUIT
