- GMRYUT2 ;HIRMFO/YH-PATIENT I/O UTILITIES - CALLS FROM DD AND IV SITE CHECK ;5/10/91
- ;;4.0;Intake/Output;;Apr 25, 1997
- EN1(GOUT,GDA,GDT) ;SCREEN PATIENT'S ADMISSION STATUS FOR THE INTAKE/OUTPUT DATE/TIME
- ;CHECK FOR ABSENCE & PASS
- N DFN S DFN=GDA,VAIP("D")=GDT D IN5^VADPT,DEM^VADPT K VAIP("D")
- I VADM(6)>0 W !!,$P(VADM(1),"^")_" died on "_$P(VADM(6),"^",2) S GOUT(1)=2 G Q
- I $G(VAIP(10))=0 W !!,VADM(1)_" on "_$P($G(VAIP(4)),"^",2),! S GOUT(1)=1
- Q Q GOUT(1)
- EN3 ;SUM UP INTAKE ITEM VOLUME
- S GMRX=0 F GMRN=0:0 S GMRN=$O(^GMR(126,DA(2),"IN",DA(1),1,GMRN)) Q:GMRN'>0 S GMRX=GMRX+$P(^GMR(126,DA(2),"IN",DA(1),1,GMRN,0),"^",2)
- S $P(^GMR(126,DA(2),"IN",DA(1),0),"^",5)=GMRX K GMRX,GMRN Q
- EN4 ;TYPE AND VOLUME OF IV STARTED
- S GTYPE=$P(^GMRD(126.9,+X,0),"^",2),$P(^GMR(126,DA(1),"IV",DA,0),"^",3)=GTYPE S:+$P(^GMRD(126.9,+X,0),"^",3)>0 $P(^GMR(126,DA(1),"IV",DA,0),"^",12)=+$P(^GMRD(126.9,+X,0),"^",3)
- S:$D(^GMR(126,DA(1),"IV",DA,0)) GMRVDT=$P(^(0),U) S:GMRVDT'="" ^GMR(126,DA(1),"IV","TYP",9999999-GMRVDT,GTYPE,DA)="" K GMRVDT,GTYPE
- Q
- EN5 ;KILL X-REF OF IV TYPE WHEN DELETE IV SOLUTION
- S $P(^GMR(126,DA(1),"IV",DA,0),"^",12)="" S GTYPE=$P(^GMR(126,DA(1),"IV",DA,0),"^",3),GMRVDT=$P(^(0),U) K:GMRVDT'=""&(GTYPE'="") ^GMR(126,DA(1),"IV","TYP",9999999-GMRVDT,GTYPE,DA) K GTYPE,GMRVDT
- Q
- EN6 ;CALL FROM DD(126 TO SCREEN INTAKE ITEM BY INPUT TYPE
- S:'$D(GEDIT) GMRYTYP=+$P($G(^GMR(126,D0,"IN",D1,0)),U,2) S DIC("S")="I $D(^GMRD(126.8,""C"",+GMRYTYP,+Y))"
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRYUT2 1478 printed Feb 18, 2025@23:22:09 Page 2
- GMRYUT2 ;HIRMFO/YH-PATIENT I/O UTILITIES - CALLS FROM DD AND IV SITE CHECK ;5/10/91
- +1 ;;4.0;Intake/Output;;Apr 25, 1997
- EN1(GOUT,GDA,GDT) ;SCREEN PATIENT'S ADMISSION STATUS FOR THE INTAKE/OUTPUT DATE/TIME
- +1 ;CHECK FOR ABSENCE & PASS
- +2 NEW DFN
- SET DFN=GDA
- SET VAIP("D")=GDT
- DO IN5^VADPT
- DO DEM^VADPT
- KILL VAIP("D")
- +3 IF VADM(6)>0
- WRITE !!,$PIECE(VADM(1),"^")_" died on "_$PIECE(VADM(6),"^",2)
- SET GOUT(1)=2
- GOTO Q
- +4 IF $GET(VAIP(10))=0
- WRITE !!,VADM(1)_" on "_$PIECE($GET(VAIP(4)),"^",2),!
- SET GOUT(1)=1
- Q QUIT GOUT(1)
- EN3 ;SUM UP INTAKE ITEM VOLUME
- +1 SET GMRX=0
- FOR GMRN=0:0
- SET GMRN=$ORDER(^GMR(126,DA(2),"IN",DA(1),1,GMRN))
- if GMRN'>0
- QUIT
- SET GMRX=GMRX+$PIECE(^GMR(126,DA(2),"IN",DA(1),1,GMRN,0),"^",2)
- +2 SET $PIECE(^GMR(126,DA(2),"IN",DA(1),0),"^",5)=GMRX
- KILL GMRX,GMRN
- QUIT
- EN4 ;TYPE AND VOLUME OF IV STARTED
- +1 SET GTYPE=$PIECE(^GMRD(126.9,+X,0),"^",2)
- SET $PIECE(^GMR(126,DA(1),"IV",DA,0),"^",3)=GTYPE
- if +$PIECE(^GMRD(126.9,+X,0),"^",3)>0
- SET $PIECE(^GMR(126,DA(1),"IV",DA,0),"^",12)=+$PIECE(^GMRD(126.9,+X,0),"^",3)
- +2 if $DATA(^GMR(126,DA(1),"IV",DA,0))
- SET GMRVDT=$PIECE(^(0),U)
- if GMRVDT'=""
- SET ^GMR(126,DA(1),"IV","TYP",9999999-GMRVDT,GTYPE,DA)=""
- KILL GMRVDT,GTYPE
- +3 QUIT
- EN5 ;KILL X-REF OF IV TYPE WHEN DELETE IV SOLUTION
- +1 SET $PIECE(^GMR(126,DA(1),"IV",DA,0),"^",12)=""
- SET GTYPE=$PIECE(^GMR(126,DA(1),"IV",DA,0),"^",3)
- SET GMRVDT=$PIECE(^(0),U)
- if GMRVDT'=""&(GTYPE'="")
- KILL ^GMR(126,DA(1),"IV","TYP",9999999-GMRVDT,GTYPE,DA)
- KILL GTYPE,GMRVDT
- +2 QUIT
- EN6 ;CALL FROM DD(126 TO SCREEN INTAKE ITEM BY INPUT TYPE
- +1 if '$DATA(GEDIT)
- SET GMRYTYP=+$PIECE($GET(^GMR(126,D0,"IN",D1,0)),U,2)
- SET DIC("S")="I $D(^GMRD(126.8,""C"",+GMRYTYP,+Y))"
- +2 QUIT