Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMRYED2

GMRYED2.m

Go to the documentation of this file.
GMRYED2 ;HIRMFO/YH-PATIENT SEARCH/START IV ;1/17/97
 ;;4.0;Intake/Output;;Apr 25, 1997
Q ;EXIT OF EDIT
 K GDEL,GDA,GDT,GMRVOPT,GMRVSEL,GMRWARD,DA,GMRDIAG,GMRVADM,GMRBED,GMRBTH,GMRSEX,GMRNAM,SSN,GMRAGE,VAROOT D KVAR^VADPT
 Q
ADM ;OBTAIN THE WARD LOC. AT THE TIME WHEN THE PATIENT WAS DISCHARGED
 S VAIP("D")="LAST" D IN5^VADPT Q:'$D(VAIN(4))  S GMRWARD(1)=$P(VAIN(4),"^",2),GMRWARD=$P(VAIN(4),"^"),GMRBED=$P(VAIN(5),"^") Q
STARTIV ; TO START A NEW IV LINE OR TO MODIFY THE DATA FOR A SELECTED IV LINE
 S GMRVTYP="",GMRDC=0,GMRDEL="",GX="",GLABEL="Current IV(s)" D LISTIV^GMRYUT0 G:'$D(GMRDATA)!(GN'>0) NEWIV W !,"Current IV(s):",! S GFLAG=0 D SEL^GMRYUT13
NEWIV W !,"Start new IV ",! S GDR=1,GCATH="" D DT^GMRYUT3 Q:GMROUT!(GX="")
 S GMROUT(1)=0,GMROUT(1)=$$ADM^GMRYUT12(.GMROUT,DFN,GX) Q:GMROUT
 ;I GMROUT(1) S GMROUT=$$CONTNU^GMRYUT12(GMROUT,"START NEW IV") Q:GMROUT
 S:'$D(GSITE) GSITE="" S:'$D(GCATH(1)) GCATH(1)="" D:'(GSITE'=""&(GCATH'="")&(GCATH(1)'="")) SITECATH^GMRYSTCA Q:GMROUT  ;I GMROUT D DELIV Q
NXTPRT S:'$D(GMRVTYP) GMRVTYP="" I GMRVTYP="" D SOLTYPE^GMRYUT7 Q:GMROUT!(GMRVTYP="")
ADDIV ;
 I GMRVTYP'="L" D ^GMRYUT6 Q:GMROUT!'$D(GMRZ)
 S GHLOC=GMRHLOC I '$D(^GMR(126,DA,"IV",0)) S ^(0)="^126.03IDA^0^0"
 S GSAVE=GMRVTYP K DD S X=+GX,DLAYGO=126.03,DA(1)=DFN,DIC="^GMR(126,"_DA(1)_",""IV"",",DIC(0)="ML" D WAIT^GMRYUT0 Q:GMROUT  D FILE^DICN L -^GMR(126,DFN) K DIC,DLAYGO,DD S DA=+Y,GMRVTYP=GSAVE Q:Y'>0!GMROUT
 S GDEL=0,GSAVE=GMRVTYP D EDIT S GMRVTYP=GSAVE Q:GDR=0!GDEL!GMROUT
MOREBTL ;
 S GST(GSITE,GLINE(1),GLINE,0)=^GMR(126,DFN,"IV",GLINE,0),GCT(GSITE)=$G(GCT(GSITE))+1,GMRLINE=+$G(GMRLINE)+1
 S GDR=2 D SITEIV^GMRYED3
QUES S %=2 W !,"Do you want to add another solution to "_$S(GLINE(1)="BLANK":"this line",1:GLINE(1)_" port") D YN^DICN Q:%<0  I %=0 G QUES
 Q:GPORT="BLANK"&(%=2)  G:%=2 SELECTP D ^GMRYUT7 Q:GMROUT!(GMRVTYP="")  I GMRVTYP'="L" D ^GMRYUT6 Q:GMROUT
 S GSAVE=GMRVTYP K DD S X=+GX,DLAYGO=126.03,DA(1)=DFN,DIC="^GMR(126,"_DA(1)_",""IV"",",DIC(0)="ML" D WAIT^GMRYUT0 Q:GMROUT  D FILE^DICN L -^GMR(126,DFN) K DIC,DLAYGO,DD S DA=+Y,GMRVTYP=GSAVE Q:Y'>0!GMROUT  D EDIT Q:GMROUT  G MOREBTL
 ;
EDIT ;
REASK S GX(1)=+GX I GMRDEL="@" S GX(2)="" W !!,"Are you sure you want to delete this IV line? YES// " R GX(2):DTIME W:GX(2)["?" !!,"Enter N(o) if you do not want to delete this IV line",! G:GX(2)["?" REASK Q:GX(2)'=""&("Nn^"[GX(2))  D DELIV Q
 I GMRVTYP="L" D LOCK^GMRYED5 S GMRZ="LOCK/PORT" I GMROUT D DELIV Q
 ;EDIT FOR START/HANG IV, DELETE THE RECORD IF DATA NOT COMPLETE
 S GLINE(1)=GMRZ_"  ("_GMRZ(1)_")  "_GMRZ(2)_" mls  "_$S(+GMRZ(3)>0:+GMRZ(3)_" ml/hr",1:"")
 S DIE="^GMR(126,"_DA(1)_",""IV"","
 S DR="2///^S X=GMRZ;3///^S X=GMRZ(1);4///^S X=GMRZ(2);11///^S X=GMRZ(3);6///^S X=""`""_DUZ;7///^S X=""`""_GHLOC;"_$S(GDR=1:"1///^S X=GSITE;5///^S X=GCATH;17///^S X=GCATH(1)",1:"1///^S X=GSITE;17///^S X=GCATH(1)")
 D WAIT^GMRYUT0 I GMROUT K DIE,DR Q
 D ^DIE S GLINE=DA,GLINE(1)=$S(GCATH(1)="":"BLANK",1:GCATH(1))
 I GDR=0!(GDR=3) S $P(^GMR(126,DA(1),"IV",DA,0),"^",2)=GSITE,^GMR(126,DA(1),"IV","SITE",GSITE,9999999-GX,DA)=""
 L -^GMR(126,DFN) K DIE,DR I $P(^GMR(126,DA(1),"IV",DA,0),"^",2)=""!($P(^(0),"^",3)="")!($P(^(0),"^",5)="") D DELIV S:GDR=0 GADD="N" Q
RESTART Q:GDR=0  S GSDC="S",X=$P(^GMR(126,DA(1),"IV",DA,0),"^",2) I $D(^GMR(126,DA(1),"IVM","B",X)) S DA=$O(^(X,0)) D EN4^GMRYUT5 Q
 I '$D(^GMR(126,DA(1),"IVM",0)) S ^GMR(126,DA(1),"IVM",0)="^126.04^0^0"
 K DD S DIC="^GMR(126,"_DA(1)_",""IVM"",",DIC(0)="ML" D WAIT^GMRYUT0 Q:GMROUT  D FILE^DICN L -^GMR(126,DFN) K DIC,DD Q:+Y'>0!GMROUT  S DA=+Y D EN4^GMRYUT5 Q
 ;
DELIV S GSITE=$P(^GMR(126,DA(1),"IV",DA,0),"^",2)
 S DIK="^GMR(126,"_DA(1)_",""IV""," D ^DIK K DIK S Y=+GX X ^DD("DD") W !!,"IV started on: "_$P(Y,":",1,2)_" has been deleted!!!" S GDEL=1 Q
LISTSOL W !,"You may select one of the following solution: ",! S GSOL=0 F  S GSOL=$O(^GMRD(126.9,GSOL)) Q:GSOL'>0  S GSOL(1)=^GMRD(126.9,GSOL,0) D WRTSOL^GMRYED5
 K GSOL Q
SELECTP ;
 Q:'$D(GMRPORT)  K GHOLD S GCATH(1)="",GHOLD=GCATH(2),(GHOLD(1),GHOLD(2),GHOLD(3))="" D FINDPORT^GMRYSTCA(.GHOLD) S GCATH(1)=GHOLD(3) K GHOLD Q:GMROUT
 S GMRVTYP="" G NXTPRT