- GMRYMNT1 ;HIRMFO/YH-IV CARE/MAINTENANCE/FLUSH (CONTINUE) ;8/13/96
- ;;4.0;Intake/Output;;Apr 25, 1997
- EN1 ;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,"
- D:$P(^GMR(126,DA(2),"IVM",DA(1),1,DA,0),"^",2)="" SITEDES^GMRYUT6 D:GMROUT KILLRC^GMRYUT9 G:GMROUT Q2 S DR="1///^S X=GMRZ;3;4///^S X=""`""_DUZ;"
- 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 GCT(GSITE)'>0 G Q2
- S GMESSG="Enter the number(s) of the line associated with the TUBING CHANGE: "
- D IVLINE^GMRYUT9 D:GMROUT KILLRC^GMRYUT9
- K GMRYZ,GN,GSEL,GMESSG
- W ! D ASKFLSH^GMRYFLSH
- Q2 K DIE,DR,GMRZ Q
- DCDATE ;OBTAIN INFUSION SITE DISCONTINUED DATE
- N I S I="" F S I=$O(GCT(I)) Q:I="" I GCT(I)=0 D
- . S I(1)=$O(^GMR(126,DFN,"IVM","B",I,0)) Q:I(1)'>0!(GMRXY(I)'="")
- . S I(2)=0 F S I(2)=$O(^GMR(126,DFN,"IVM",I(1),1,"C",I(2))) Q:I(2)'>0 S I(3)=$O(^GMR(126,DFN,"IVM",I(1),1,"C",I(2),0)) Q:I(3)'>0!(GMRXY(I)'="") D
- . . I $E($P($G(^GMR(126,DFN,"IVM",I(1),1,I(3),0)),"^",6))="Y" D
- . . . S GMRXY(I)=9999999-I(2),GMRXY(I)=$E(GMRXY(I),4,5)_"/"_$E(GMRXY(I),6,7)_"/"_$E(GMRXY(I),2,3)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRYMNT1 1511 printed Mar 13, 2025@21:00:08 Page 2
- GMRYMNT1 ;HIRMFO/YH-IV CARE/MAINTENANCE/FLUSH (CONTINUE) ;8/13/96
- +1 ;;4.0;Intake/Output;;Apr 25, 1997
- EN1 ;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 $PIECE(^GMR(126,DA(2),"IVM",DA(1),1,DA,0),"^",2)=""
- DO SITEDES^GMRYUT6
- if GMROUT
- DO KILLRC^GMRYUT9
- if GMROUT
- GOTO Q2
- SET DR="1///^S X=GMRZ;3;4///^S X=""`""_DUZ;"
- 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 GCT(GSITE)'>0
- GOTO Q2
- +3 SET GMESSG="Enter the number(s) of the line associated with the TUBING CHANGE: "
- +4 DO IVLINE^GMRYUT9
- if GMROUT
- DO KILLRC^GMRYUT9
- +5 KILL GMRYZ,GN,GSEL,GMESSG
- +6 WRITE !
- DO ASKFLSH^GMRYFLSH
- Q2 KILL DIE,DR,GMRZ
- QUIT
- DCDATE ;OBTAIN INFUSION SITE DISCONTINUED DATE
- +1 NEW I
- SET I=""
- FOR
- SET I=$ORDER(GCT(I))
- if I=""
- QUIT
- IF GCT(I)=0
- Begin DoDot:1
- +2 SET I(1)=$ORDER(^GMR(126,DFN,"IVM","B",I,0))
- if I(1)'>0!(GMRXY(I)'="")
- QUIT
- +3 SET I(2)=0
- FOR
- SET I(2)=$ORDER(^GMR(126,DFN,"IVM",I(1),1,"C",I(2)))
- if I(2)'>0
- QUIT
- SET I(3)=$ORDER(^GMR(126,DFN,"IVM",I(1),1,"C",I(2),0))
- if I(3)'>0!(GMRXY(I)'="")
- QUIT
- Begin DoDot:2
- +4 IF $EXTRACT($PIECE($GET(^GMR(126,DFN,"IVM",I(1),1,I(3),0)),"^",6))="Y"
- Begin DoDot:3
- +5 SET GMRXY(I)=9999999-I(2)
- SET GMRXY(I)=$EXTRACT(GMRXY(I),4,5)_"/"_$EXTRACT(GMRXY(I),6,7)_"/"_$EXTRACT(GMRXY(I),2,3)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +6 QUIT
