source: FOIAVistA/trunk/r/GEN_MED_REC_VITALS-GMRV/GMRVSR0.m@ 767

Last change on this file since 767 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 5.5 KB
Line 
1GMRVSR0 ;HIRMFO/RM,YH-VITAL SIGNS RECORD SF 511 ;2/12/99 12:25
2 ;;4.0;Vitals/Measurements;**1,3,7,9,11**;Apr 25, 1997
3EN1 ; ENTRY POINT FROM OPTION GMRV SF511, SELECT TYPE OF GRAPH FOR THE REPORT
4 S (GMRVWLOC,GMROUT,GFLAG,GRAPH)=0 D SELECT^GMRVSR1(.GRAPH) I GRAPH'>0 K GFLAG,GMROUT,GRAPH,GMRVWLOC Q
5 D WARDPAT^GMRVED0 I GMROUT D Q1 K GFLAG,GMREDB,GMROUT,GMRWARD,DFN,GRAPH Q
6PAT I "Pp"[GMREDB D DEM^VADPT S GMRNAM=$P(VADM(1),"^"),SSN=$P(VADM(2),"^",2)
7 I "Ss"[GMREDB D EN3^GMRVED6
8 I GMROUT D Q1 K GMREDB,GFLAG,GMROUT,GMRWARD,GRAPH Q
9DATE S %DT("A")="Start DATE (TIME optional): ",%DT("B")="T-7",%DT="AETX" D ^%DT K %DT G:+Y'>0 Q1 S GMRSTRT=+Y
10 S %DT("A")="go to DATE (TIME optional): ",%DT="AETX",%DT("B")="NOW" D ^%DT K %DT G:+Y'>0 Q1 I $P(Y,".",2)'>0,Y=DT D NOW^%DTC S Y=%
11 I $P(Y,".",2)'>0 S Y=Y_$S(Y[".":"2400",1:".2400")
12 S (X1,GMRFIN)=+Y,X2=GMRSTRT D ^%DTC
13 I X<0!(X=0&(((+("."_$P(GMRFIN,".",2))*10000)-((+("."_$P(GMRSTRT,".",2))*10000)))'>0)) W !?5,"Ending date of range needs to be greater that starting date.",!?5,$C(7),"PLEASE REENTER!!" G DATE
14 D DATELN
15DEV S %ZIS="NQ",%ZIS("B")=""
16 W ! D ^%ZIS G:POP Q1
17 N GMRVDEV S GMRVDEV=ION_";"_IOST_";"_IOM_";"_IOSL
18 I IOM'>131 W !!,"Sorry, you must select a DEVICE that can print 132 columns. Try again." G DEV ;device must be 132 columns
19 I '$D(IO("Q")) S IOP=GMRVDEV K %ZIS D ^%ZIS G Q1:POP,EN2:"Pp"[GMREDB,EN3
20 I $D(IO("Q")) S ZTDESC="V/M GRAPHIC REPORTS",ZTIO=GMRVDEV,ZTRTN=$S("Pp"[GMREDB:"EN2^GMRVSR0",1:"EN3^GMRVSR0") F G="GRAPH","GMROUT","DFN","GMRROOM(","GMREDB","GMRNAM","SSN","GMRWARD","GMRSTRT","GMRFIN","GMRWARD(","GFLAG","GSTRFIN" S ZTSAVE(G)=""
21 I $D(IO("Q")) D ^%ZTLOAD,HOME^%ZIS K ZTSK,ZTIO,DFN,GMRLEN,GMRRMST,GMRIFN,GMROUT,GMRSTRT,GMRVLOC,GMRWARD D Q1,Q2 Q
22 G:'("Pp"[GMREDB) EN3
23EN2 ; ENTRY TO PRINT THIS REPORT AFTER IT HAS BEEN QUEUED
24 ; NOTE: THIS REPORT MUST BE QUEUED TO A PRINTER.
25 N GAPICAL,GRADIAL,GBRACHI S GAPICAL=$O(^GMRD(120.52,"B","APICAL",0)),GRADIAL=$O(^GMRD(120.52,"B","RADIAL",0)),GBRACHI=$O(^GMRD(120.52,"B","BRACHIAL",0))
26 I IOST["KYOCERA"!(IOST["Kyocera") S GROUTN=$S(GRAPH=1:"EN1^GMRVGR0",GRAPH=2:"EN1^GMRVBP0",GRAPH=3:"EN1^GMRVWT0",GRAPH=4:"EN1^GMRVKPO0",GRAPH=5:"^GMRVKPN0",1:"") D:GROUTN'="" @GROUTN G:"Pp"[GMREDB Q1 Q
27 I $$UP^XLFSTR(IOST)["HPLASER" S GROUTN=$S(GRAPH=1:"EN1^GMRVHG0",GRAPH=2:"EN1^GMRVHB0",GRAPH=3:"EN1^GMRVHW0",GRAPH=4:"EN1^GMRVHPO0",GRAPH=5:"EN1^GMRVHPN0",1:"") D:GROUTN'="" @GROUTN G:"Pp"[GMREDB Q1 Q
28 I GRAPH=2 D ^GMRVLBP0 G:"Pp"[GMREDB Q1 Q
29 I GRAPH=3 D ^GMRVLWT0 G:"Pp"[GMREDB Q1 Q
30 I GRAPH=4 D ^GMRVLPO0 G:"Pp"[GMREDB Q1 Q
31 I GRAPH=5 W !!,"Sorry, you must select a Kyocera or HP Laser printer for the Pain Chart." S:'$G(GMRPERR) GMRPERR=1 G:"Pp"[GMREDB Q1 Q
32 S GMRS=(9999999-GMRFIN)-.0001,GMRQ=9999999-GMRSTRT
33 F GMRTY="B","P","R","T","H","W","PO2","CVP","CG","PN" D SETT^GMRVSR1
34 U IO D SF511^GMRVSR1
35Q1 K J,G,GMR,GMR3,GMRDAT,GMRDT,GMREN,GMRHDR1,GMRHDR10,GMRHDR11,GMRHDR2,GMRHT,GMRI,GMRJ,GMRK,GMRLINE,GMRMSL,GMRNM,GMROLD,GMRP,GMRPDIF,GMRT,GMRX,GMRTY,GMRPG,GMRPGC,GMRPGS,GMRPHI,GMRPLO,GMRTDIF,GMRTHI,GMRTLO,GMRTNM,GMRX1,GMRX2 D KVAR^VADPT K VA,%T
36 K GVAR,GMRDIV,GMRHT,GMRQUAL,GMRS,GMRQ,GMRPOFF,GMRTOFF,GMRVWLOC,GMRVX,DIK,%ZIS,%DT,DIPGM,GMRLEN,GMRRMST,GMRVHLOC,GDA,GMRINF,GLINE,GMRVARY,GMRPERR,GMRVPS
37 W:$E(IOST)="P"!$D(IO("S"))&($$UP^XLFSTR(IOST)'["HPLASER") ! Q:'("Pp"[GMREDB)
38Q2 S:$D(ZTQUEUED) ZTREQ="@" K ^TMP($J),GMRII,GMRQUAL,GMREDB,GMROUT,GMRROOM,GMRSTRT,GMRFIN,GMRNAM,GMRRMBD,GMRSITE,GMRVHLOC,GMRWARD,POP,SSN,DFN,ZTIO,ZTSK,GDT,GDTA,GFOUND,GMRAGE,GMRBED,GMRBTH,GMRCOL,GMRHLOC,GMROP,GMRSEX,GMRVADM,GRPT,GSUB,GTYPE1
39 K GSTRFIN,GMRVFLAG,SNN,GMVRMBD,GMVWRD,GRAPH,GROUTN,GIVDT,GSTAR,GSOL,GN,GNDATE,GNSHFT,GFLAG,ZTSAVE,ZTRTN W:$E(IOST)'="C"&(IOST'["KYOC"!(IOST'["Kyoc")!(IOST'["kyoc")!($$UP^XLFSTR(IOST)'["HPLASER")) @IOF D ^%ZISC Q
40EN3 ; ENTRY TO PRINT REPORT FOR ALL OR SELECTED GROUP OF PATIENTS, FOR WARD STORED IN GMRWARD
41 S GMRPERR=0
42 D EN1^GMRVED2 S GMRROOM="" F GMRII=0:0 S GMRROOM=$O(^TMP($J,GMRROOM)) Q:GMRROOM="" S GMRNAM="" F GMRII=0:0 S GMRNAM=$O(^TMP($J,GMRROOM,GMRNAM)) Q:GMRNAM="" F DFN=0:0 S DFN=$O(^TMP($J,GMRROOM,GMRNAM,DFN)) Q:DFN'>0 D:DFN>0 PRT
43 D Q1 G Q2
44PRT ;
45 D DEM^VADPT S SSN=$P(VADM(2),"^",2) Q:$G(GMRPERR)&('$D(IO("Q"))) D EN2
46 Q
47EN4 ; ENTRY POINT IF DFN IS KNOWN TO PRINT THIS REPORT
48 Q:'$D(DFN) S GRAPH=1,GMREDB="P",GMROUT=0,GMRVHLOC=+ORL D INP^VADPT S GMRWARD(1)=$P(VAIN(4),"^",2),GMRWARD=$P(VAIN(4),"^") G PAT
49 Q
50EN5 ; ENTRY POINT FOR APPLICATION TO GET REPORT. INPUT VARIABLES:
51 ; DFN=PATIENT NUMBER
52 ; GMRDATE=START DATE^FINISH DATE OF REPORT^TYPE OF GRAPH
53 ; (OPTIONAL) GMRVWLO=LOCATION GROUPING OF PATIENT IF DIFFERENT HAN 42 FILE
54 Q:'$D(DFN)!'$D(GMRDATE)!(DFN'>0) Q:'$P(GMRDATE,"^")!'$P(GMRDATE,"^",2) S GMREDB="A",GMROUT=0,GMRSTRT=$P(GMRDATE,"^"),GMRFIN=$P(GMRDATE,"^",2) D INP^VADPT S GMRWARD(1)=$S($D(GMRVWLO):GMRVWLO,1:$P(VAIN(4),"^",2)),GMRWARD=$P(VAIN(4),"^")
55 D DATELN S GRAPH=$S($P(GMRDATE,"^",3)>0:+$P(GMRDATE,"^",3),1:1) D EN2 Q
56EN6(DFN,GMRDATE) ; APPLICATION PROGRAM INTERFACE FOR SINGLE PATIENT REPORT. INPUT VARIABLES: DFN=PATIENT NUMBER
57 ; GMRDATE=START DATE^FINISH DATE OF REPORT
58 Q:'$D(DFN)!'$D(GMRDATE) Q:'$P(GMRDATE,U)!'$P(GMRDATE,U,2) S GMREDB="P",GMROUT=0,GMRSTRT=$P(GMRDATE,U),GMRFIN=$P(GMRDATE,U,2) D DEM^VADPT,INP^VADPT S SSN=VA("PID"),GMRWARD=$P(VAIN(4),U),GMRWARD(1)=$P(VAIN(4),U,2)
59 I IOM'>130 D Q
60 .S GMRVDVIC=$E(IOST) ;device type chosen by user (e.g., 'C')
61 .D ^%ZISC
62 .W !,"THIS REPORT NEEDS 132 COLUMNS",!
63 .I GMRVDVIC'="C" H 3 ;if device is not a terminal hang 3 seconds
64 .K GMRVDVIC
65 .Q
66 D DATELN S GRAPH=$S($P(GMRDATE,"^",3)>0:+$P(GMRDATE,"^",3),1:1) D EN2 Q
67DATELN ;
68 S Y=GMRSTRT X ^DD("DD") S GSTRFIN=Y S Y=GMRFIN X ^DD("DD") S GSTRFIN=GSTRFIN_" - "_Y Q
Note: See TracBrowser for help on using the repository browser.