NURCES2 ;HIRMFO/YH-END OF SHIFT REPORT PART 3 - ITEMIZED I/O DATA ;7/15/97
;;4.0;NURSING SERVICE;**2,24**;Apr 25, 1997
SETARRY ;SET DATA IN ^TMP($J,"GMRY", FOR EACH PATIENT
S (GDCIV,GQ,GQT,GMROUT)=0,GRPT=10 I '$D(^GMR(126,"B",DFN)) Q
S GSAVEH=0,DA(1)=$O(^GMR(126,"B",DFN,0)) K ^TMP($J,"GMRY")
F II="IN","OUT" D SAVE^GMRYRP2
D SAVEIV^GMRYRP2,IVM
D REPORT1^GMRYRP3 S NURTLTI=$S('$D(GTOTLI):"",1:GTOTLI),NURTLTO=$S('$D(GTOTLO):"",1:GTOTLO) D SETIV K GRPT,GSAVE Q
SETIV ;SET IV TEXT
D IV^NURCES3,IVTUBE
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,"B"))
S GSTRT=0 F S GSTRT=$O(^GMR(126,DA(1),"IVM",DA,1,"B",GSTRT)) Q:GSTRT'>0 S GMRINDT=GSTRT,GDAY=0 D NEXT^GMRYRP1 I '(GMRINDT<GMRSTRT!(GMRINDT>GMRFIN)) D SETSIFT^GMRYRP2 D
. S GDA=0 F S GDA=$O(^GMR(126,DA(1),"IVM",DA,1,"B",GSTRT,GDA)) Q:GDA'>0 D SETUT
Q
SETUT ;
S GSITE(GSITE)="" D FINDCA^GMRYCATH(.GSITE)
S GPORT=+$P($G(^GMR(126,DA(1),"IVM",DA,1,GDA,0)),"^",7),GPORT=$S($D(^GMR(126,DFN,"IV",GPORT,3)):$P(^(3),"^"),1:"")
S ^TMP($J,"GMRY",$P(GMRINDT,"."),GSHIFT,"IV",GMRINDT,GSTRT,"Z",GDA,1)=$P(^GMR(126,DA(1),"IVM",DA,1,GDA,0),"^",1,5)_"^"_$P(^(0),"^",6)_"^"_GSITE_"^"_GSITE(GSITE)_"^"_GPORT Q
IVTUBE ;OBTAIN LAST TUBING CHANGED
D SELSITE^GMRYMNT Q:'$D(GMRXY) K NURTUBE S N=0 F S N=$O(GMRXY(N)) Q:N'>0 D TUBING
K GDA,GYES,GCT,GDATA,GDT,GIVDT,GMRXY,GSITE,GST Q
TUBING S GSITE="",NURTUBE=0 F S GSITE=$O(GMRXY(N,GSITE)) Q:GSITE="" I GCT(GSITE)>0 S GYES=0,GDA=$S('$D(^GMR(126,DFN,"IVM","B",GSITE)):"",1:$O(^GMR(126,DFN,"IVM","B",GSITE,0))) D:GDA>0 CHANGED
Q
CHANGED ;
S GDA(1)=0 F S GDA(1)=$O(^GMR(126,DFN,"IVM",GDA,1,"C",GDA(1))) Q:GDA(1)'>0!GYES S GDA(2)=0 F S GDA(2)=$O(^GMR(126,DFN,"IVM",GDA,1,"C",GDA(1),GDA(2))) Q:GDA(2)'>0!GYES D CHANGED1
Q
CHANGED1 ;
I $D(^GMR(126,DFN,"IVM",GDA,1,GDA(2),0)),$P(^(0),"^",3)["Y" S NURTUBE(GSITE)=$P(^(0),"^"),GYES=1,NURTUBE=NURTUBE+1
Q
I $E(IOST)="C",NURSW1 W !,$C(7),"Enter <RET> to continue " R X:DTIME I '$T!(X="^") S NURQUIT=1 Q
S Y=(GMRFIN+.0001)_"00"
S NURPAGE=NURPAGE+1,NURSW1=1 W:NURPAGE>1 @IOF
W !,NURDT,?20,"END-OF-SHIFT REPORT",?40,"UNIT: ",NPWARD W ?$S(NOPT=1:90,NOPT=2:55,1:55),"TOUR: "_+$E($P(GMRSTRT,".",2),1,2)_":"_$E($P(GMRSTRT,".",2)_"00",3,4)_"-"_+$E($P(Y,".",2),1,2)_":",$E($P(Y,".",2),3,4)
W ?$S(NOPT=1:118,NOPT=2:72,1:72),"PAGE:",NURPAGE
W !,"ROOM-BED/NAME/SSN/",?25,"|ADMITTING DX/ |PT |LATEST VITALS" W:NOPT=1 ?68,"|PATIENT PROBLEMS"
W !,"SPECIALTY/DIET/ALLERGIES",?25,"|DATE/MDs",?42,"|CAT|" W:NOPT=1 ?68,"|",!,NURX,! W:NOPT=2 !,$E(NURX,1,79),!
Q
PTDATA ;
S NPT(1)=$S($P(VAIN(5),"^")'="":$P(VAIN(5),"^"),1:"")
S NPT(2)=$S(N1'=" BLANK":$E(N1,1,17),1:""),NPT(3)=NSSN,NPT=3 D FITLINE^NURCES5("Specialty: "_$P($G(VAIN(3)),"^",2),25,.NPT)
I GFH D FITLINE^NURCES5(NDIET,25,.NPT)
D ALLERGY^NURCES4
S NCL(1)=$S($D(NURCAT):NURCAT,1:"") S NADM=0 D INP^VADPT D FITLINE^NURCES5(VAIN(9),16,.NADM)
S Y=$P(VAIN(7),"^") S:Y'="" NADM=NADM+1,NADM(NADM)=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3) S Y=$P(Y,".",2) S:Y'="" NADM(NADM)=NADM(NADM)_"@"_$E(Y_"00",1,2) S Y=$E(Y,3,4) S:Y'="" NADM(NADM)=NADM(NADM)_":"_$E(Y_"0",1,2)
S NADM=NADM+1,NADM(NADM)=$P(VADM(4),"^")_" yrs. "_$S($P(VADM(5),"^",2)'="":$P(VADM(5),"^",2),1:" ")
I $P($G(VAIN(11)),"^",2)'="" D K G
. S G=0,NADM=NADM+1,NADM(NADM)=$P(VAIN(11),"^",2),G=$O(^VA(200,"B",NADM(NADM),0)),NADM=NADM+1,NADM(NADM)=" (A)"
. I G>0,$D(^VA(200,G,.13)) S G(1)=$P($G(^(.13)),"^",7),G(2)=$P($G(^(.13)),"^",8) D
. . I G(1)'="" S NADM=NADM+1,NADM(NADM)=G(1) D
. . . I $L(G(1))>11 S NADM=NADM+1,NADM(NADM)=" (V)"
. . . E S NADM(NADM)=NADM(NADM)_" (V)"
. . I G(2)'="" S NADM=NADM+1,NADM(NADM)=G(2) D
. . . I $L(G(2))>11 S NADM=NADM+1,NADM(NADM)=" (D)"
. . . E S NADM(NADM)=NADM(NADM)_" (D)"
I $P($G(VAIN(2)),"^",2)'="" D K G
. S G=0,NADM=NADM+1,NADM(NADM)=$P(VAIN(2),"^",2),G=$O(^VA(200,"B",NADM(NADM),0)),NADM=NADM+1,NADM(NADM)=" (P)"
. I G>0,$D(^VA(200,G,.13)) S G(1)=$P($G(^(.13)),"^",7),G(2)=$P($G(^(.13)),"^",8) D
. . I G(1)'="" S NADM=NADM+1,NADM(NADM)=G(1) D
. . . I $L(G(1))>11 S NADM=NADM+1,NADM(NADM)=" (V)"
. . . E S NADM(NADM)=NADM(NADM)_" (V)"
. . I G(2)'="" S NADM=NADM+1,NADM(NADM)=G(2) D
. . . I $L(G(2))>11 S NADM=NADM+1,NADM(NADM)=" (D)"
. . . E S NADM(NADM)=NADM(NADM)_" (D)"
S NVM(1)="" D VM^NURCES1 I GPACK,$D(NURTLTI) S:NURTLTI>0 NADM=NADM+1,NADM(NADM)="Intake: "_NURTLTI
I GPACK,$D(NURTLTO) S:NURTLTO>0 NADM=NADM+1,NADM(NADM)="Output: "_NURTLTO
K NURTLTI,NURTLTO Q
PRINT2 I $D(NPT(NN)),(NPT(NN)'="") W $E(NPT(NN),1,25)
W ?25,"|" I $D(NADM(NN)),(NADM(NN)'="") W $E(NADM(NN),1,16)
W ?42,"|" I $D(NCL(NN)),(NCL(NN)'="") W NCL(NN)
W ?46,"|" I $D(NVM(NN)),(NVM(NN)'="") W NVM(NN)
I NOPT=1 W ?68,"|" I $D(NPR(NN)),(NPR(NN)'="") W NPR(NN)
W ! Q
NURCES2 ;HIRMFO/YH-END OF SHIFT REPORT PART 3 - ITEMIZED I/O DATA ;7/15/97
+1 ;;4.0;NURSING SERVICE;**2,24**;Apr 25, 1997
SETARRY ;SET DATA IN ^TMP($J,"GMRY", FOR EACH PATIENT
+1 SET (GDCIV,GQ,GQT,GMROUT)=0
SET GRPT=10
IF '$DATA(^GMR(126,"B",DFN))
QUIT
+2 SET GSAVEH=0
SET DA(1)=$ORDER(^GMR(126,"B",DFN,0))
KILL ^TMP($JOB,"GMRY")
+3 FOR II="IN","OUT"
DO SAVE^GMRYRP2
+4 DO SAVEIV^GMRYRP2
DO IVM
+5 DO REPORT1^GMRYRP3
SET NURTLTI=$SELECT('$DATA(GTOTLI):"",1:GTOTLI)
SET NURTLTO=$SELECT('$DATA(GTOTLO):"",1:GTOTLO)
DO SETIV
KILL GRPT,GSAVE
QUIT
SETIV ;SET IV TEXT
+1 DO IV^NURCES3
DO IVTUBE
+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,"B"))
QUIT
+2 SET GSTRT=0
FOR
SET GSTRT=$ORDER(^GMR(126,DA(1),"IVM",DA,1,"B",GSTRT))
IF GSTRT'>0
QUIT
SET GMRINDT=GSTRT
SET GDAY=0
DO NEXT^GMRYRP1
IF '(GMRINDT<GMRSTRT!(GMRINDT>GMRFIN))
DO SETSIFT^GMRYRP2
Begin DoDot:1
+3 SET GDA=0
FOR
SET GDA=$ORDER(^GMR(126,DA(1),"IVM",DA,1,"B",GSTRT,GDA))
IF GDA'>0
QUIT
DO SETUT
End DoDot:1
+4 QUIT
SETUT ;
+1 SET GSITE(GSITE)=""
DO FINDCA^GMRYCATH(.GSITE)
+2 SET GPORT=+$PIECE($GET(^GMR(126,DA(1),"IVM",DA,1,GDA,0)),"^",7)
SET GPORT=$SELECT($DATA(^GMR(126,DFN,"IV",GPORT,3)):$PIECE(^(3),"^"),1:"")
+3 SET ^TMP($JOB,"GMRY",$PIECE(GMRINDT,"."),GSHIFT,"IV",GMRINDT,GSTRT,"Z",GDA,1)=$PIECE(^GMR(126,DA(1),"IVM",DA,1,GDA,0),"^",1,5)_"^"_$PIECE(^(0),"^",6)_"^"_GSITE_"^"_GSITE(GSITE)_"^"_GPORT
QUIT
IVTUBE ;OBTAIN LAST TUBING CHANGED
+1 DO SELSITE^GMRYMNT
IF '$DATA(GMRXY)
QUIT
KILL NURTUBE
SET N=0
FOR
SET N=$ORDER(GMRXY(N))
IF N'>0
QUIT
DO TUBING
+2 KILL GDA,GYES,GCT,GDATA,GDT,GIVDT,GMRXY,GSITE,GST
QUIT
TUBING SET GSITE=""
SET NURTUBE=0
FOR
SET GSITE=$ORDER(GMRXY(N,GSITE))
IF GSITE=""
QUIT
IF GCT(GSITE)>0
SET GYES=0
SET GDA=$SELECT('$DATA(^GMR(126,DFN,"IVM","B",GSITE)):"",1:$ORDER(^GMR(126,DFN,"IVM","B",GSITE,0)))
IF GDA>0
DO CHANGED
+1 QUIT
CHANGED ;
+1 SET GDA(1)=0
FOR
SET GDA(1)=$ORDER(^GMR(126,DFN,"IVM",GDA,1,"C",GDA(1)))
IF GDA(1)'>0!GYES
QUIT
SET GDA(2)=0
FOR
SET GDA(2)=$ORDER(^GMR(126,DFN,"IVM",GDA,1,"C",GDA(1),GDA(2)))
IF GDA(2)'>0!GYES
QUIT
DO CHANGED1
+2 QUIT
CHANGED1 ;
+1 IF $DATA(^GMR(126,DFN,"IVM",GDA,1,GDA(2),0))
IF $PIECE(^(0),"^",3)["Y"
SET NURTUBE(GSITE)=$PIECE(^(0),"^")
SET GYES=1
SET NURTUBE=NURTUBE+1
+2 QUIT
+1 IF $EXTRACT(IOST)="C"
IF NURSW1
WRITE !,$CHAR(7),"Enter <RET> to continue "
READ X:DTIME
IF '$TEST!(X="^")
SET NURQUIT=1
QUIT
+2 SET Y=(GMRFIN+.0001)_"00"
+3 SET NURPAGE=NURPAGE+1
SET NURSW1=1
IF NURPAGE>1
WRITE @IOF
+4 WRITE !,NURDT,?20,"END-OF-SHIFT REPORT",?40,"UNIT: ",NPWARD
WRITE ?$SELECT(NOPT=1:90,NOPT=2:55,1:55),"TOUR: "_+$EXTRACT($PIECE(GMRSTRT,".",2),1,2)_":"_$EXTRACT($PIECE(GMRSTRT,".",2)_"00",3,4)_"-"_+$EXTRACT($PIECE(Y,".",2),1,2)_":",$EXTRACT($PIECE(Y,".",2),3,4)
+5 WRITE ?$SELECT(NOPT=1:118,NOPT=2:72,1:72),"PAGE:",NURPAGE
+6 WRITE !,"ROOM-BED/NAME/SSN/",?25,"|ADMITTING DX/ |PT |LATEST VITALS"
IF NOPT=1
WRITE ?68,"|PATIENT PROBLEMS"
+7 WRITE !,"SPECIALTY/DIET/ALLERGIES",?25,"|DATE/MDs",?42,"|CAT|"
IF NOPT=1
WRITE ?68,"|",!,NURX,!
IF NOPT=2
WRITE !,$EXTRACT(NURX,1,79),!
+8 QUIT
PTDATA ;
+1 SET NPT(1)=$SELECT($PIECE(VAIN(5),"^")'="":$PIECE(VAIN(5),"^"),1:"")
+2 SET NPT(2)=$SELECT(N1'=" BLANK":$EXTRACT(N1,1,17),1:"")
SET NPT(3)=NSSN
SET NPT=3
DO FITLINE^NURCES5("Specialty: "_$PIECE($GET(VAIN(3)),"^",2),25,.NPT)
+3 IF GFH
DO FITLINE^NURCES5(NDIET,25,.NPT)
+4 DO ALLERGY^NURCES4
+5 SET NCL(1)=$SELECT($DATA(NURCAT):NURCAT,1:"")
SET NADM=0
DO INP^VADPT
DO FITLINE^NURCES5(VAIN(9),16,.NADM)
+6 SET Y=$PIECE(VAIN(7),"^")
IF Y'=""
SET NADM=NADM+1
SET NADM(NADM)=$EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_"/"_$EXTRACT(Y,2,3)
SET Y=$PIECE(Y,".",2)
IF Y'=""
SET NADM(NADM)=NADM(NADM)_"@"_$EXTRACT(Y_"00",1,2)
SET Y=$EXTRACT(Y,3,4)
IF Y'=""
SET NADM(NADM)=NADM(NADM)_":"_$EXTRACT(Y_"0",1,2)
+7 SET NADM=NADM+1
SET NADM(NADM)=$PIECE(VADM(4),"^")_" yrs. "_$SELECT($PIECE(VADM(5),"^",2)'="":$PIECE(VADM(5),"^",2),1:" ")
+8 IF $PIECE($GET(VAIN(11)),"^",2)'=""
Begin DoDot:1
+9 SET G=0
SET NADM=NADM+1
SET NADM(NADM)=$PIECE(VAIN(11),"^",2)
SET G=$ORDER(^VA(200,"B",NADM(NADM),0))
SET NADM=NADM+1
SET NADM(NADM)=" (A)"
+10 IF G>0
IF $DATA(^VA(200,G,.13))
SET G(1)=$PIECE($GET(^(.13)),"^",7)
SET G(2)=$PIECE($GET(^(.13)),"^",8)
Begin DoDot:2
+11 IF G(1)'=""
SET NADM=NADM+1
SET NADM(NADM)=G(1)
Begin DoDot:3
+12 IF $LENGTH(G(1))>11
SET NADM=NADM+1
SET NADM(NADM)=" (V)"
+13 IF '$TEST
SET NADM(NADM)=NADM(NADM)_" (V)"
End DoDot:3
+14 IF G(2)'=""
SET NADM=NADM+1
SET NADM(NADM)=G(2)
Begin DoDot:3
+15 IF $LENGTH(G(2))>11
SET NADM=NADM+1
SET NADM(NADM)=" (D)"
+16 IF '$TEST
SET NADM(NADM)=NADM(NADM)_" (D)"
End DoDot:3
End DoDot:2
End DoDot:1
KILL G
+17 IF $PIECE($GET(VAIN(2)),"^",2)'=""
Begin DoDot:1
+18 SET G=0
SET NADM=NADM+1
SET NADM(NADM)=$PIECE(VAIN(2),"^",2)
SET G=$ORDER(^VA(200,"B",NADM(NADM),0))
SET NADM=NADM+1
SET NADM(NADM)=" (P)"
+19 IF G>0
IF $DATA(^VA(200,G,.13))
SET G(1)=$PIECE($GET(^(.13)),"^",7)
SET G(2)=$PIECE($GET(^(.13)),"^",8)
Begin DoDot:2
+20 IF G(1)'=""
SET NADM=NADM+1
SET NADM(NADM)=G(1)
Begin DoDot:3
+21 IF $LENGTH(G(1))>11
SET NADM=NADM+1
SET NADM(NADM)=" (V)"
+22 IF '$TEST
SET NADM(NADM)=NADM(NADM)_" (V)"
End DoDot:3
+23 IF G(2)'=""
SET NADM=NADM+1
SET NADM(NADM)=G(2)
Begin DoDot:3
+24 IF $LENGTH(G(2))>11
SET NADM=NADM+1
SET NADM(NADM)=" (D)"
+25 IF '$TEST
SET NADM(NADM)=NADM(NADM)_" (D)"
End DoDot:3
End DoDot:2
End DoDot:1
KILL G
+26 SET NVM(1)=""
DO VM^NURCES1
IF GPACK
IF $DATA(NURTLTI)
IF NURTLTI>0
SET NADM=NADM+1
SET NADM(NADM)="Intake: "_NURTLTI
+27 IF GPACK
IF $DATA(NURTLTO)
IF NURTLTO>0
SET NADM=NADM+1
SET NADM(NADM)="Output: "_NURTLTO
+28 KILL NURTLTI,NURTLTO
QUIT
PRINT2 IF $DATA(NPT(NN))
IF (NPT(NN)'="")
WRITE $EXTRACT(NPT(NN),1,25)
+1 WRITE ?25,"|"
IF $DATA(NADM(NN))
IF (NADM(NN)'="")
WRITE $EXTRACT(NADM(NN),1,16)
+2 WRITE ?42,"|"
IF $DATA(NCL(NN))
IF (NCL(NN)'="")
WRITE NCL(NN)
+3 WRITE ?46,"|"
IF $DATA(NVM(NN))
IF (NVM(NN)'="")
WRITE NVM(NN)
+4 IF NOPT=1
WRITE ?68,"|"
IF $DATA(NPR(NN))
IF (NPR(NN)'="")
WRITE NPR(NN)
+5 WRITE !
QUIT
