- GMRYFLW0 ;HIRMFO/YH-INTRAVENOUS INFUSION FLOW SHEET ;1/25/93
- ;;4.0;Intake/Output;;Apr 25, 1997
- EN1 ;IV FLOW SHEET
- S GMROUT=0,GRPT=8 D DATE^GMRYRP1 G:GMROUT Q S GMROP(1)=$S($D(GMRNUR):"WARDPAT^GMRYUT4",1:"MASPT^GMRYRP5") D @GMROP(1) G:GMROUT Q
- DEV W !,$C(7),"** THIS REPORT NEEDS 132 COLUMNS - PORT/LAND **" D DEV^GMRYRP0 I POP G Q
- I IOM<81 D ^%ZISC G DEV
- I $D(IO("Q")) K IO("Q"),IO("C") S ZTDESC="IV FLOW SHEET",ZTRTN="START^GMRYFLW0",ZTIO=ION_";"_IOM_";"_IOSL D LOOP,^%ZTLOAD D Q2^GMRYRP0 K GMRNAM,GMRWARD Q
- START ;
- U IO
- S GPC=0,GDASH="",$P(GDASH,"-",132)="",GBLNK="",$P(GBLNK," ",132)="",GMROUT=0
- S GLINE="" F I=8,5,20,4,4,5,16,16,4,4,5,13 S GLINE=GLINE_$E(GBLNK,1,I)_"|"
- S GLINE=$E(GLINE_GBLNK,1,132),GQT=0,GQ=0
- I "Pp"[GMREDB D PATIENT^GMRYUT9,SETARRY,REPORT^GMRYFLW1,Q,Q2^GMRYRP0 Q
- I "SsWw"[GMREDB D:$D(GMRNUR) PATIENT^GMRYUT11
- G:'$D(^TMP("GMRPT",$J)) Q
- S GROOM="" F J=0:0 S GROOM=$O(^TMP("GMRPT",$J,GROOM)) Q:GROOM=""!GMROUT S GBED="" F J=0:0 S GBED=$O(^TMP("GMRPT",$J,GROOM,GBED)) Q:GBED=""!GMROUT S DFN=0 F J=0:0 S DFN=$O(^TMP("GMRPT",$J,GROOM,GBED,DFN)) Q:DFN'>0!GMROUT D PRNT Q:GMROUT
- D Q D Q2^GMRYRP0 K GMRNAM,GMRWARD Q
- LOOP F X="GNRMBD(","^TMP(""GMRPT"",$J,","GMROUT","GMRNUR","GMRFIN","GMRSTRT","GMREDB","GRPT","DFN","GMRCOL","GMRWARD","GMRWARD(" S ZTSAVE(X)=""
- Q
- PRNT S (GQ,GQT)=0 D PT^GMRYUT0,SETARRY,REPORT^GMRYFLW1
- Q
- Q ;
- K GMRVHLOC,GMRVWLOC,GMROP,GMROUT,GMREDB,GMRFIN,GST,GDC,GDTIME,GTOTAL,GSTM,GMRSTRT,GCATH,GBLNK,GDASH,GSDA,GSDAY,GDATE,GLEFT,GABSORB,GRPT,GSTAR,GDA,GMRY,GSAVE,GSAVEH,GMRHLOC,GDATA D Q^GMRYRP0
- K SSN,GMRAGE,GMRBED,GMRBTH,GMRDIAG,GMRHLOC,GMRNAM,GMRSEX,GMRADM,GMRWARD,VAROOT,I,X,Y,DFN Q
- SETARRY ;SET IV DATA IN ^TMP($J,"GMR" AND SITE CARE IN ^TMP($J,"GMRY", FOR EACH PATIENT
- K ^TMP($J) I $D(^GMR(126,"B",DFN)) S GSAVEH=0,DA(1)=$O(^GMR(126,"B",DFN,0)) D SAVEIV,IVM
- Q
- IVM ;SET IV MAINTENANCE IN ^TMP($J,"GMRY"
- Q:'$D(^GMR(126,DFN,"IVM","B"))
- S GSITE="" F S GSITE=$O(^GMR(126,DA(1),"IVM","B",GSITE)) Q:GSITE="" S DA=$O(^(GSITE,0)) Q:DA'>0 D SCARE
- Q
- SCARE ;
- Q:'$D(^GMR(126,DA(1),"IVM",DA,1,"C"))
- S GSTRT=0 F S GSTRT=$O(^GMR(126,DA(1),"IVM",DA,1,"C",GSTRT)) Q:GSTRT'>0 S GMRINDT=9999999-GSTRT I '(GMRINDT<GMRSTRT!(GMRINDT>GMRFIN)) S GDA=0 F S GDA=$O(^GMR(126,DA(1),"IVM",DA,1,"C",GSTRT,GDA)) Q:GDA'>0 D SETUT
- Q
- SETUT S GDATA=^GMR(126,DA(1),"IVM",DA,1,GDA,0) I $P(GDATA,"^",7)'="" S ^TMP($J,"GMR",+$P(GDATA,"^",7),GMRINDT,999)=^(0) Q
- S ^TMP($J,"GMRY",GSITE,GMRINDT,999)=GDATA Q
- SAVEIV ;SET ^TMP($J,"GMR" FOR IV INTAKE
- I '$D(^GMR(126,DA(1),"IV","C")) Q
- S GIVSTRT=0 F JJ=0:0 S GIVSTRT=$O(^GMR(126,DA(1),"IV","C",GIVSTRT)) Q:GIVSTRT'>0 S GMRINDT=9999999-GIVSTRT Q:GMRINDT<GMRSTRT I GMRINDT'>GMRFIN D IV
- Q
- IV ;
- S DA=0 F S DA=$O(^GMR(126,DA(1),"IV","C",GIVSTRT,DA)) Q:DA'>0 Q:'$D(^GMR(126,DA(1),"IV",DA,0)) D IVDA
- Q
- IVDA ;
- S GSITE=$P($G(^GMR(126,DA(1),"IV",DA,0)),"^",2),GSTRT=$P($G(^(0)),"^") Q:GSITE="" S ^TMP($J,"GMRY",GSITE,GMRINDT,DA)=$P(^(0)_"^^^^^","^",1,13)
- S $P(^TMP($J,"GMRY",GSITE,GMRINDT,DA),"^",13)=$P($G(^GMR(126,DA(1),"IV",DA,3)),"^") ;IV PORT
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRYFLW0 3079 printed Feb 18, 2025@23:21:46 Page 2
- GMRYFLW0 ;HIRMFO/YH-INTRAVENOUS INFUSION FLOW SHEET ;1/25/93
- +1 ;;4.0;Intake/Output;;Apr 25, 1997
- EN1 ;IV FLOW SHEET
- +1 SET GMROUT=0
- SET GRPT=8
- DO DATE^GMRYRP1
- if GMROUT
- GOTO Q
- SET GMROP(1)=$SELECT($DATA(GMRNUR):"WARDPAT^GMRYUT4",1:"MASPT^GMRYRP5")
- DO @GMROP(1)
- if GMROUT
- GOTO Q
- DEV WRITE !,$CHAR(7),"** THIS REPORT NEEDS 132 COLUMNS - PORT/LAND **"
- DO DEV^GMRYRP0
- IF POP
- GOTO Q
- +1 IF IOM<81
- DO ^%ZISC
- GOTO DEV
- +2 IF $DATA(IO("Q"))
- KILL IO("Q"),IO("C")
- SET ZTDESC="IV FLOW SHEET"
- SET ZTRTN="START^GMRYFLW0"
- SET ZTIO=ION_";"_IOM_";"_IOSL
- DO LOOP
- DO ^%ZTLOAD
- DO Q2^GMRYRP0
- KILL GMRNAM,GMRWARD
- QUIT
- START ;
- +1 USE IO
- +2 SET GPC=0
- SET GDASH=""
- SET $PIECE(GDASH,"-",132)=""
- SET GBLNK=""
- SET $PIECE(GBLNK," ",132)=""
- SET GMROUT=0
- +3 SET GLINE=""
- FOR I=8,5,20,4,4,5,16,16,4,4,5,13
- SET GLINE=GLINE_$EXTRACT(GBLNK,1,I)_"|"
- +4 SET GLINE=$EXTRACT(GLINE_GBLNK,1,132)
- SET GQT=0
- SET GQ=0
- +5 IF "Pp"[GMREDB
- DO PATIENT^GMRYUT9
- DO SETARRY
- DO REPORT^GMRYFLW1
- DO Q
- DO Q2^GMRYRP0
- QUIT
- +6 IF "SsWw"[GMREDB
- if $DATA(GMRNUR)
- DO PATIENT^GMRYUT11
- +7 if '$DATA(^TMP("GMRPT",$JOB))
- GOTO Q
- +8 SET GROOM=""
- FOR J=0:0
- SET GROOM=$ORDER(^TMP("GMRPT",$JOB,GROOM))
- if GROOM=""!GMROUT
- QUIT
- SET GBED=""
- FOR J=0:0
- SET GBED=$ORDER(^TMP("GMRPT",$JOB,GROOM,GBED))
- if GBED=""!GMROUT
- QUIT
- SET DFN=0
- FOR J=0:0
- SET DFN=$ORDER(^TMP("GMRPT",$JOB,GROOM,GBED,DFN))
- if DFN'>0!GMROUT
- QUIT
- DO PRNT
- if GMROUT
- QUIT
- +9 DO Q
- DO Q2^GMRYRP0
- KILL GMRNAM,GMRWARD
- QUIT
- LOOP FOR X="GNRMBD(","^TMP(""GMRPT"",$J,","GMROUT","GMRNUR","GMRFIN","GMRSTRT","GMREDB","GRPT","DFN","GMRCOL","GMRWARD","GMRWARD("
- SET ZTSAVE(X)=""
- +1 QUIT
- PRNT SET (GQ,GQT)=0
- DO PT^GMRYUT0
- DO SETARRY
- DO REPORT^GMRYFLW1
- +1 QUIT
- Q ;
- +1 KILL GMRVHLOC,GMRVWLOC,GMROP,GMROUT,GMREDB,GMRFIN,GST,GDC,GDTIME,GTOTAL,GSTM,GMRSTRT,GCATH,GBLNK,GDASH,GSDA,GSDAY,GDATE,GLEFT,GABSORB,GRPT,GSTAR,GDA,GMRY,GSAVE,GSAVEH,GMRHLOC,GDATA
- DO Q^GMRYRP0
- +2 KILL SSN,GMRAGE,GMRBED,GMRBTH,GMRDIAG,GMRHLOC,GMRNAM,GMRSEX,GMRADM,GMRWARD,VAROOT,I,X,Y,DFN
- QUIT
- SETARRY ;SET IV DATA IN ^TMP($J,"GMR" AND SITE CARE IN ^TMP($J,"GMRY", FOR EACH PATIENT
- +1 KILL ^TMP($JOB)
- IF $DATA(^GMR(126,"B",DFN))
- SET GSAVEH=0
- SET DA(1)=$ORDER(^GMR(126,"B",DFN,0))
- DO SAVEIV
- DO IVM
- +2 QUIT
- IVM ;SET IV MAINTENANCE IN ^TMP($J,"GMRY"
- +1 if '$DATA(^GMR(126,DFN,"IVM","B"))
- QUIT
- +2 SET GSITE=""
- FOR
- SET GSITE=$ORDER(^GMR(126,DA(1),"IVM","B",GSITE))
- if GSITE=""
- QUIT
- SET DA=$ORDER(^(GSITE,0))
- if DA'>0
- QUIT
- DO SCARE
- +3 QUIT
- SCARE ;
- +1 if '$DATA(^GMR(126,DA(1),"IVM",DA,1,"C"))
- QUIT
- +2 SET GSTRT=0
- FOR
- SET GSTRT=$ORDER(^GMR(126,DA(1),"IVM",DA,1,"C",GSTRT))
- if GSTRT'>0
- QUIT
- SET GMRINDT=9999999-GSTRT
- IF '(GMRINDT<GMRSTRT!(GMRINDT>GMRFIN))
- SET GDA=0
- FOR
- SET GDA=$ORDER(^GMR(126,DA(1),"IVM",DA,1,"C",GSTRT,GDA))
- if GDA'>0
- QUIT
- DO SETUT
- +3 QUIT
- SETUT SET GDATA=^GMR(126,DA(1),"IVM",DA,1,GDA,0)
- IF $PIECE(GDATA,"^",7)'=""
- SET ^TMP($JOB,"GMR",+$PIECE(GDATA,"^",7),GMRINDT,999)=^(0)
- QUIT
- +1 SET ^TMP($JOB,"GMRY",GSITE,GMRINDT,999)=GDATA
- QUIT
- SAVEIV ;SET ^TMP($J,"GMR" FOR IV INTAKE
- +1 IF '$DATA(^GMR(126,DA(1),"IV","C"))
- QUIT
- +2 SET GIVSTRT=0
- FOR JJ=0:0
- SET GIVSTRT=$ORDER(^GMR(126,DA(1),"IV","C",GIVSTRT))
- if GIVSTRT'>0
- QUIT
- SET GMRINDT=9999999-GIVSTRT
- if GMRINDT<GMRSTRT
- QUIT
- IF GMRINDT'>GMRFIN
- DO IV
- +3 QUIT
- IV ;
- +1 SET DA=0
- FOR
- SET DA=$ORDER(^GMR(126,DA(1),"IV","C",GIVSTRT,DA))
- if DA'>0
- QUIT
- if '$DATA(^GMR(126,DA(1),"IV",DA,0))
- QUIT
- DO IVDA
- +2 QUIT
- IVDA ;
- +1 SET GSITE=$PIECE($GET(^GMR(126,DA(1),"IV",DA,0)),"^",2)
- SET GSTRT=$PIECE($GET(^(0)),"^")
- if GSITE=""
- QUIT
- SET ^TMP($JOB,"GMRY",GSITE,GMRINDT,DA)=$PIECE(^(0)_"^^^^^","^",1,13)
- +2 ;IV PORT
- SET $PIECE(^TMP($JOB,"GMRY",GSITE,GMRINDT,DA),"^",13)=$PIECE($GET(^GMR(126,DA(1),"IV",DA,3)),"^")
- +3 QUIT