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