GMRYUT2.m

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

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