Changeset 636 for FOIAVistA/tag/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC
- Timestamp:
- Dec 4, 2009, 8:26:01 PM (14 years ago)
- Location:
- FOIAVistA/tag/r
- Files:
-
- 5 edited
- 1 copied
Legend:
- Unmodified
- Added
- Removed
-
FOIAVistA/tag/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBCREQ1.m
r628 r636 1 1 DVBCREQ1 ;ALB/GTS-557/THM-NEW 2507 REQUEST PRINTING ; 5/25/91 11:36 AM 2 ;;2.7;AMIE;**19,29 ,126**;Apr 10, 1995;Build 82 ;;2.7;AMIE;**19,29**;Apr 10, 1995 3 3 ; 4 4 START S PGHD="COMPENSATION AND PENSION EXAM REQUEST",ROHD="Requested by "_RONAME,PG=0 … … 6 6 D SSNOUT^DVBCUTIL ;** Set the value of DVBCSSNO 7 7 W !?2,"Name: ",PNAM,?56,"SSN: ",DVBCSSNO,!?51,"C-Number: ",CNUM,!?56,"DOB: " S Y=DOB X ^DD("DD") W Y,!?2,"Address: ",ADR1,! W:ADR2]"" ?11,ADR2,! W:ADR3]"" ?11,ADR3,!! 8 W ?2,"City,State,Zip+4: ",?48,"Res Phone: ",HOMPHON,!?5,CITY," ",STATE," ",ZIP,?48,"Bus Phone: ",BUSPHON,! ;I IOST?1"C-".E D CRTBOT G:$D(GETOUT) EXIT ;DVBA/126 comment off this code 9 I $D(^DPT(DFN,.121)) I $D(DTT) D ;DVBA/126 10 .Q:$P(DTT,U,9)=""!($P(DTT,U,9)="N") 11 .I $P(DTT,U,7)'="" Q:$P(DTT,U,7)>DT 12 .I $P(DTT,U,8)'="" Q:$P(DTT,U,8)<DT 13 .W !?2,"Temporary Address: ",TAD1,! W:TAD2]"" ?21,TAD2,! W:TAD3]"" ?21,TAD3,! 14 .W ?2,"City,State,Zip+4: ",?48,"Temporary Phone: ",!?5,TCITY," ",TST," ",TZIP,?51,TPHONE,! 15 I IOST?1"C-".E D CRTBOT G:$D(GETOUT) EXIT ;DVBA/126 8 W !?2,"City,State,Zip+4: ",?48,"Res Phone: ",HOMPHON,!?5,CITY," ",STATE," ",ZIP,?48,"Bus Phone: ",BUSPHON,! I IOST?1"C-".E D CRTBOT G:$D(GETOUT) EXIT 16 9 W !,"Entered active service: " S Y=EOD X ^DD("DD") S:Y="" Y="Not specified" W Y,?40,"Last rating exam date: ",LREXMDT,! S Y=RAD X ^DD("DD") S:Y="" Y="Not specified" W "Released active service: " W Y,! 17 10 F LINE=1:1:80 W "=" … … 37 30 D:('$D(GETOUT)) ^DIWW 38 31 ; ** Exit TAG ** 39 EXIT D:('$D(GETOUT)) BOT K GETOUT,LPCNT,DVBCDX,DVBCSC,DVBCSSNO ,DTT,TAD1,TAD2,TAD3,TCITY,TST,TZIP,TPHONEQ32 EXIT D:('$D(GETOUT)) BOT K GETOUT,LPCNT,DVBCDX,DVBCSC,DVBCSSNO Q 40 33 ; 41 34 HDR S PG=PG+1 I '$D(ONE)!(($D(ONE))&(PG>1))!(IOST?1"C-".E) W @IOF -
FOIAVistA/tag/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBCRPR1.m
r628 r636 1 1 DVBCRPR1 ;ALBANY-ISC/GTS-REPRINT C&P REPORT CONTINUED ;4/28/93 2 ;;2.7;AMIE;**2,119**;Apr 10, 1995;Build 10 2 ;;2.7;AMIE;**2,119**;Apr 10, 1995;Build 4;WorldVistA 30-Jan-08 3 ;Modified from FOIA VISTA, 4 ;Copyright 2008 WorldVistA. Licensed under the terms of the GNU 5 ;General Public License See attached copy of the License. 6 ; 7 ;This program is free software; you can redistribute it and/or modify 8 ;it under the terms of the GNU General Public License as published by 9 ;the Free Software Foundation; either version 2 of the License, or 10 ;(at your option) any later version. 11 ; 12 ;This program is distributed in the hope that it will be useful, 13 ;but WITHOUT ANY WARRANTY; without even the implied warranty of 14 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 ;GNU General Public License for more details. 16 ; 17 ;You should have received a copy of the GNU General Public License along 18 ;with this program; if not, write to the Free Software Foundation, Inc., 19 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 3 20 ; 4 21 ; ** Entry points called only from DVBCRPRT ** 5 22 ; ** All TAGS are entry points ** 6 23 HDR S PG=PG+1 7 I +$G(DVBGUI)& &(PG>1) Q24 I +$G(DVBGUI)&(PG>1) Q 8 25 I PG>1 D HDR3^DVBCUTL2 Q 9 26 S:ZPR'="E" TOTTIME=$$PROCDAY^DVBCUTL2(DA(1)) -
FOIAVistA/tag/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBCRPRT.m
r628 r636 1 1 DVBCRPRT ;ALB/GTS-557/THM-REPRINT C&P REPORT ; 5/17/91 10:28 AM 2 ;;2.7;AMIE;**31,42,119**;Apr 10, 1995;Build 10 2 ;;2.7;AMIE;**31,42,119**;Apr 10, 1995;Build 4;WorldVistA 30-Jan-08 3 ;Modified from FOIA VISTA, 4 ;Copyright 2008 WorldVistA. Licensed under the terms of the GNU 5 ;General Public License See attached copy of the License. 6 ; 7 ;This program is free software; you can redistribute it and/or modify 8 ;it under the terms of the GNU General Public License as published by 9 ;the Free Software Foundation; either version 2 of the License, or 10 ;(at your option) any later version. 11 ; 12 ;This program is distributed in the hope that it will be useful, 13 ;but WITHOUT ANY WARRANTY; without even the implied warranty of 14 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 ;GNU General Public License for more details. 16 ; 17 ;You should have received a copy of the GNU General Public License along 18 ;with this program; if not, write to the Free Software Foundation, Inc., 19 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 3 20 ; 4 21 ; ** DVBCRPRT is called from DVBCRPON only ** … … 25 42 .I $Y>(IOSL-9) D HDR^DVBCRPR1 26 43 I '+$G(DVBGUI) D 27 .I $Y>(IOSL-9) D UP^DVBCRPR1,NEXT,HDR^DVBCRPR1 W:$O(^DVB(396.4,OLDA,"RES",LINE))]""& &('+$G(DVBGUI)) !!,"Exam Results Continued",!!44 .I $Y>(IOSL-9) D UP^DVBCRPR1,NEXT,HDR^DVBCRPR1 W:$O(^DVB(396.4,OLDA,"RES",LINE))]""&('+$G(DVBGUI)) !!,"Exam Results Continued",!! 28 45 Q 29 46 GO ; ** An external entry point called from DVBCRPON ** -
FOIAVistA/tag/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBCUTIL.m
r628 r636 1 1 DVBCUTIL ;ALB/GTS-557/THM;C&P UTILITY ROUTINE ; 4/26/91 11:16 AM 2 ;;2.7;AMIE;**17 ,126**;Apr 10, 1995;Build 82 ;;2.7;AMIE;**17**;Apr 10, 1995 3 3 KILL ;common exit 4 4 D ^%ZISC I $D(FF),'$D(ZTQUEUED) W @FF,!! … … 6 6 K SEX,SSN,STATE,TST,X,Y,Z,JI,JII,ZIP,JJ,KJX,D0,D1,DA,DI,DIC,DIPGM,DLAYGO,DQ,DWLW,HD,HD1,HD2,J,ONFILE,CTIM,JJ,C,DIZ,DPTSZ,STAT,JDT,JY,TSTDT,DIYS,EXAM,DR,REQDT,ELIG,INCMP,PRDSV,WARD,ADD1,ADD2,CNTY,PG,OLDDA,DIRUT,DUOUT 7 7 K DVBCCNT,TNAM,DIR,TEMP,SWITCH,EDTA,RAD,EOD,%T,STATUS,XX,XDD,OLDA,OLDA1 8 K DTTRNSC,ZIP4,DVBAINSF ,DTT,TAD1,TAD2,TAD3,TCITY,TST,TZIP,TPHONE8 K DTTRNSC,ZIP4,DVBAINSF 9 9 G KILL^DVBCUTL2 10 10 ; … … 28 28 S CITY=$S(CITY]"":CITY,1:"Unknown") S STATE=$P(DTA,U,5) I STATE]"" S STATE=$S($D(^DIC(5,STATE,0)):$P(^(0),U,1),1:"Unknown") 29 29 S (HOMPHON,BUSPHON)="Unknown" I $D(^DPT(DFN,.13)) S HOMPHON=$P(^(.13),U,1),BUSPHON=$P(^(.13),U,2) 30 I $D(^DPT(DFN,.121)) D ;DVBA/126 added31 .S (DTT,TAD1,TAD2,TAD3,TCITY,TST,TZIP,TPHONE)=""32 .S DTT=^DPT(DFN,.121)33 .S TAD1=$P(DTT,U,1),TAD2=$P(DTT,U,2),TAD3=$P(DTT,U,3),TCITY=$P(DTT,U,4)34 .S TZIP=$P(DTT,U,12) S:TZIP'="" TZIP=$S($L(TZIP)>5:$E(TZIP,1,5)_"-"_$E(TZIP,6,9),1:TZIP) I TZIP="" S TZIP="No Zip"35 .S TCITY=$S(TCITY]"":TCITY,1:"Unknown") S TST=$P(DTT,U,5) I TST]"" S TST=$S($D(^DIC(5,TST,0)):$P(^(0),U,1),1:"Unknown")36 .S TPHONE=$P(DTT,U,10) S:TPHONE="" TPHONE="Unknown"37 30 S EDTA=$S($D(^DPT(DFN,.32)):^(.32),1:""),EOD=$P(EDTA,U,6),RAD=$P(EDTA,U,7),Y=$S($D(^DVB(396.3,DA,1)):$P(^(1),U,7),1:"") X ^DD("DD") S LREXMDT=Y 38 31 Q -
FOIAVistA/tag/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBCWNS5.m
r628 r636 48 48 ;; 49 49 ;; 1. Inspection: spine, limbs, posture and gait, position of the 50 ;; 51 ;; 50 ;; head, curvatures of the spine, symmetry in appearance, symmetry 51 ;; and rhythm of spinal motion. 52 52 ;; 53 53 ;; 2. Range of motion … … 56 56 ;; 57 57 ;; The reproducibility of an individual's range of motion is one 58 ;; 59 ;; 60 ;; 61 ;; 62 ;; 63 ;; 58 ;; indicator of optimum effort. Pain, fear of injury, disuse or 59 ;; neuromuscular inhibition may limit mobility by decreasing the 60 ;; individual's effort. If range of motion measurements fail to 61 ;; match known pathology, please repeat the measurements. 62 ;; (Reference: Guides to the Evaluation of Permanent Impairment, 63 ;; Fifth Edition, 2001, page 399). 64 64 ;; 65 65 ;; i. Using a goniometer, measure and report the range of motion in … … 135 135 ;; motion for the thoracolumbar spine as a unit are as follows: 136 136 ;; 137 ;; 138 ;; 139 ;; 140 ;; 141 ;; 142 ;; 137 ;; -Forward flexion: 0 to 90 degrees 138 ;; -Extension: 0 to 30 degrees 139 ;; -Left Lateral Flexion: 0 to 30 degrees 140 ;; -Right Lateral Flexion: 0 to 30 degrees 141 ;; -Left Lateral Rotation: 0 to 30 degrees 142 ;; -Right Lateral Rotation: 0 to 30 degrees 143 143 ;; 144 144 ;;There may be a situation where an individual's range of motion is reduced, but
Note:
See TracChangeset
for help on using the changeset viewer.