- GMRVSC1 ;HIOFO/YH,FT-CUMULATIVE V/M - CONTINUED ;9/27/07
- ;;5.0;GEN. MED. REC. - VITALS;**23**;Oct 31, 2002;Build 25
- ;
- ; This routine uses the following IAs:
- ; #4290 - ^PXRMINDX global (controlled)
- ; #10061 - ^VADPT calls (supported)
- ;
- EN1 ; ENTRY TO PRINT REPORT FROM TASKMAN
- N GMVCLIO
- K ^TMP($J,"GMRV"),GMRVDT S GMRVHT=0 S (GMROUT,GMRDATE(0))=0
- F GMRVTY="T","P","R","BP","HT","WT","CVP","CG","PO2","PN" S GMRVITY=$O(^GMRD(120.51,"C",GMRVTY,0)) I GMRVITY>0 D SETAR,SETAR1
- I $O(^TMP($J,"GMRV",0))'>0 W !,"THERE IS NO DATA FOR THIS REPORT" G QT
- F GMRDATE=0:0 S GMRDATE=$O(GMRVDT(GMRDATE)) Q:GMRDATE'>0!GMROUT I $D(^TMP($J,"GMRV",GMRDATE)) D PRT Q:GMROUT
- QT I IOSL'<($Y+10) F X=1:1 W ! Q:IOSL<($Y+10)
- I 'GMROUT W ! D FOOTER^GMRVSC0
- I $E(IOST)'="P",'GMROUT W "Press return to continue or ""^"" to escape " R X:DTIME S:'$T!(X["^") GMROUT=1
- K ^TMP($J,"GMRV"),^TMP($J,"OTHR"),GOTHR,GMRV,GMRVDT Q
- Q ; KILL VARIBLES
- S:$D(ZTQUEUED) ZTREQ="@" K GMRZZ,GMRVARY
- K GMRVER,GDATA,GMRST,GERROR,GERST,^TMP($J),GBED,GWARD,DFN,GX,GMR1ST,GMRDAT,GMRDATE,GMRDSH,GMRDT,GMRLN,GMRPDT,GMRSP,GMRVDA,GMRVITY,GMRX,GMRY,GMRVTY,GMRSITE,GMRVX,POP,DIPGM,%T,GMRQUAL,GMROUT,GMRPG,GFLAG D KVAR^VADPT K VA D ^%ZISC
- Q
- SETAR ;get clio records
- S GMRDT=GMRVSDT-.000001
- F S GMRDT=$O(^PXRMINDX(120.5,"PI",DFN,GMRVITY,GMRDT)) Q:GMRDT'>0!(GMRDT>GMRVFDT) S GMRDATE=GMRDT D SETND
- Q
- SETAR1 ; PXRMINDX index doesn't have entered-in-error records, so use AA x-ref
- N GMRVSDT1,GMRVFDT1
- S GMRDT=9999999-GMRVFDT,GMRVSDT1=9999999-GMRVSDT
- S GMRDT=GMRDT-.000001,GMRVSDT1=GMRVSDT1+.000001
- F S GMRDT=$O(^GMR(120.5,"AA",DFN,GMRVITY,GMRDT)) Q:GMRDT'>0!(GMRDT>GMRVSDT1) D SETND1
- Q
- SETND ;
- S GMRVDA=0
- F S GMRVDA=$O(^PXRMINDX(120.5,"PI",DFN,GMRVITY,GMRDT,GMRVDA)) Q:GMRVDA="" D
- .Q:GMRVDA=+GMRVDA ;already got it SETND1
- .I GMRVDA'=+GMRVDA D
- ..D CLIO^GMVUTL(.GMVCLIO,GMRVDA)
- ..S GMVCLIO(0)=$G(GMVCLIO(0)),GMVCLIO(2)=$G(GMVCLIO(2)),GMVCLIO(5)=$G(GMVCLIO(5))
- ..I GMVCLIO(0)=""!($P(GMVCLIO(0),U,8)="") Q
- ..D SETUT
- ..Q
- .Q
- Q
- SETND1 ;
- S GMRVDA=0
- F S GMRVDA=$O(^GMR(120.5,"AA",DFN,GMRVITY,GMRDT,GMRVDA)) Q:GMRVDA="" D
- .D F1205^GMVUTL(.GMVCLIO,GMRVDA,1)
- .S GMVCLIO(0)=$G(GMVCLIO(0)),GMVCLIO(2)=$G(GMVCLIO(2)),GMVCLIO(5)=$G(GMVCLIO(5))
- .I GMVCLIO(0)=""!($P(GMVCLIO(0),U,8)="") Q
- .S GMRDATE=$P(GMVCLIO(0),U,1)
- .D SETUT
- .Q
- Q
- SETUT ;
- S ^TMP($J,"GMRV",GMRDATE,GMRVTY,GMRVDA)=$S($P(GMVCLIO(2),U,1)'=1:0,1:+$P(GMVCLIO(2),U,1))_"|"_GMVCLIO(0)_"|"_GMVCLIO(5)
- S GMRVDT(GMRDATE)=""
- Q
- PRT ;PRINT V/M BY DATE/TIME
- D:IOSL<($Y+9) HDR^GMRVSC2 Q:GMROUT
- S Y=GMRDATE X ^DD("DD") I $P(GMRDATE,".")'=GMRDATE(0) W !,$E(GMRDATE,4,5)_"/"_$E(GMRDATE,6,7)_"/"_$E(GMRDATE,2,3) S GMRDATE(0)=$P(GMRDATE,".")
- D:IOSL<($Y+9) HDR^GMRVSC2 Q:GMROUT W !,$P($P(Y,"@",2),":",1,2)
- I $D(^TMP($J,"GMRV",GMRDATE)) D
- .K GMRLN,GERROR F GMRVTY="T","P","R","BP","HT","WT","CVP","CG","PO2","PN" S GPRT(GMRVTY)=0 I $D(^TMP($J,"GMRV",GMRDATE,GMRVTY)) S GMRVDA="" F GMRVDA=$O(^TMP($J,"GMRV",GMRDATE,GMRVTY,GMRVDA)) Q:$L(GMRVDA)'>0!GMROUT D SETLN^GMRVSC2
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRVSC1 3074 printed Feb 18, 2025@23:23:54 Page 2
- GMRVSC1 ;HIOFO/YH,FT-CUMULATIVE V/M - CONTINUED ;9/27/07
- +1 ;;5.0;GEN. MED. REC. - VITALS;**23**;Oct 31, 2002;Build 25
- +2 ;
- +3 ; This routine uses the following IAs:
- +4 ; #4290 - ^PXRMINDX global (controlled)
- +5 ; #10061 - ^VADPT calls (supported)
- +6 ;
- EN1 ; ENTRY TO PRINT REPORT FROM TASKMAN
- +1 NEW GMVCLIO
- +2 KILL ^TMP($JOB,"GMRV"),GMRVDT
- SET GMRVHT=0
- SET (GMROUT,GMRDATE(0))=0
- +3 FOR GMRVTY="T","P","R","BP","HT","WT","CVP","CG","PO2","PN"
- SET GMRVITY=$ORDER(^GMRD(120.51,"C",GMRVTY,0))
- IF GMRVITY>0
- DO SETAR
- DO SETAR1
- +4 IF $ORDER(^TMP($JOB,"GMRV",0))'>0
- WRITE !,"THERE IS NO DATA FOR THIS REPORT"
- GOTO QT
- +5 FOR GMRDATE=0:0
- SET GMRDATE=$ORDER(GMRVDT(GMRDATE))
- if GMRDATE'>0!GMROUT
- QUIT
- IF $DATA(^TMP($JOB,"GMRV",GMRDATE))
- DO PRT
- if GMROUT
- QUIT
- QT IF IOSL'<($Y+10)
- FOR X=1:1
- WRITE !
- if IOSL<($Y+10)
- QUIT
- +1 IF 'GMROUT
- WRITE !
- DO FOOTER^GMRVSC0
- +2 IF $EXTRACT(IOST)'="P"
- IF 'GMROUT
- WRITE "Press return to continue or ""^"" to escape "
- READ X:DTIME
- if '$TEST!(X["^")
- SET GMROUT=1
- +3 KILL ^TMP($JOB,"GMRV"),^TMP($JOB,"OTHR"),GOTHR,GMRV,GMRVDT
- QUIT
- Q ; KILL VARIBLES
- +1 if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- KILL GMRZZ,GMRVARY
- +2 KILL GMRVER,GDATA,GMRST,GERROR,GERST,^TMP($JOB),GBED,GWARD,DFN,GX,GMR1ST,GMRDAT,GMRDATE,GMRDSH,GMRDT,GMRLN,GMRPDT,GMRSP,GMRVDA,GMRVITY,GMRX,GMRY,GMRVTY,GMRSITE,GMRVX,POP,DIPGM,%T,GMRQUAL,GMROUT,GMRPG,GFLAG
- DO KVAR^VADPT
- KILL VA
- DO ^%ZISC
- +3 QUIT
- SETAR ;get clio records
- +1 SET GMRDT=GMRVSDT-.000001
- +2 FOR
- SET GMRDT=$ORDER(^PXRMINDX(120.5,"PI",DFN,GMRVITY,GMRDT))
- if GMRDT'>0!(GMRDT>GMRVFDT)
- QUIT
- SET GMRDATE=GMRDT
- DO SETND
- +3 QUIT
- SETAR1 ; PXRMINDX index doesn't have entered-in-error records, so use AA x-ref
- +1 NEW GMRVSDT1,GMRVFDT1
- +2 SET GMRDT=9999999-GMRVFDT
- SET GMRVSDT1=9999999-GMRVSDT
- +3 SET GMRDT=GMRDT-.000001
- SET GMRVSDT1=GMRVSDT1+.000001
- +4 FOR
- SET GMRDT=$ORDER(^GMR(120.5,"AA",DFN,GMRVITY,GMRDT))
- if GMRDT'>0!(GMRDT>GMRVSDT1)
- QUIT
- DO SETND1
- +5 QUIT
- SETND ;
- +1 SET GMRVDA=0
- +2 FOR
- SET GMRVDA=$ORDER(^PXRMINDX(120.5,"PI",DFN,GMRVITY,GMRDT,GMRVDA))
- if GMRVDA=""
- QUIT
- Begin DoDot:1
- +3 ;already got it SETND1
- if GMRVDA=+GMRVDA
- QUIT
- +4 IF GMRVDA'=+GMRVDA
- Begin DoDot:2
- +5 DO CLIO^GMVUTL(.GMVCLIO,GMRVDA)
- +6 SET GMVCLIO(0)=$GET(GMVCLIO(0))
- SET GMVCLIO(2)=$GET(GMVCLIO(2))
- SET GMVCLIO(5)=$GET(GMVCLIO(5))
- +7 IF GMVCLIO(0)=""!($PIECE(GMVCLIO(0),U,8)="")
- QUIT
- +8 DO SETUT
- +9 QUIT
- End DoDot:2
- +10 QUIT
- End DoDot:1
- +11 QUIT
- SETND1 ;
- +1 SET GMRVDA=0
- +2 FOR
- SET GMRVDA=$ORDER(^GMR(120.5,"AA",DFN,GMRVITY,GMRDT,GMRVDA))
- if GMRVDA=""
- QUIT
- Begin DoDot:1
- +3 DO F1205^GMVUTL(.GMVCLIO,GMRVDA,1)
- +4 SET GMVCLIO(0)=$GET(GMVCLIO(0))
- SET GMVCLIO(2)=$GET(GMVCLIO(2))
- SET GMVCLIO(5)=$GET(GMVCLIO(5))
- +5 IF GMVCLIO(0)=""!($PIECE(GMVCLIO(0),U,8)="")
- QUIT
- +6 SET GMRDATE=$PIECE(GMVCLIO(0),U,1)
- +7 DO SETUT
- +8 QUIT
- End DoDot:1
- +9 QUIT
- SETUT ;
- +1 SET ^TMP($JOB,"GMRV",GMRDATE,GMRVTY,GMRVDA)=$SELECT($PIECE(GMVCLIO(2),U,1)'=1:0,1:+$PIECE(GMVCLIO(2),U,1))_"|"_GMVCLIO(0)_"|"_GMVCLIO(5)
- +2 SET GMRVDT(GMRDATE)=""
- +3 QUIT
- PRT ;PRINT V/M BY DATE/TIME
- +1 if IOSL<($Y+9)
- DO HDR^GMRVSC2
- if GMROUT
- QUIT
- +2 SET Y=GMRDATE
- XECUTE ^DD("DD")
- IF $PIECE(GMRDATE,".")'=GMRDATE(0)
- WRITE !,$EXTRACT(GMRDATE,4,5)_"/"_$EXTRACT(GMRDATE,6,7)_"/"_$EXTRACT(GMRDATE,2,3)
- SET GMRDATE(0)=$PIECE(GMRDATE,".")
- +3 if IOSL<($Y+9)
- DO HDR^GMRVSC2
- if GMROUT
- QUIT
- WRITE !,$PIECE($PIECE(Y,"@",2),":",1,2)
- +4 IF $DATA(^TMP($JOB,"GMRV",GMRDATE))
- Begin DoDot:1
- +5 KILL GMRLN,GERROR
- FOR GMRVTY="T","P","R","BP","HT","WT","CVP","CG","PO2","PN"
- SET GPRT(GMRVTY)=0
- IF $DATA(^TMP($JOB,"GMRV",GMRDATE,GMRVTY))
- SET GMRVDA=""
- FOR GMRVDA=$ORDER(^TMP($JOB,"GMRV",GMRDATE,GMRVTY,GMRVDA))
- if $LENGTH(GMRVDA)'>0!GMROUT
- QUIT
- DO SETLN^GMRVSC2
- End DoDot:1
- +6 QUIT