Changeset 636 for FOIAVistA/tag/r/DENTAL-DEN
- Timestamp:
- Dec 4, 2009, 8:26:01 PM (15 years ago)
- Location:
- FOIAVistA/tag/r
- Files:
-
- 1 edited
- 1 copied
Legend:
- Unmodified
- Added
- Removed
-
FOIAVistA/tag/r/DENTAL-DEN/DENTA14.m
r628 r636 1 1 DENTA14 ;ISC2/SAW,HAG-TREATMENT DATA REPORT - INDIVIDUAL SITTINGS ;3/29/88 2 ;;1.2;DENTAL;**16,19**;JAN 26, 1989 2 ;;1.2;DENTAL;**16,19**;JAN 26, 1989;Build 4 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. 20 ; 21 ; 3080129 - RCR - The Variable, DENTSD is an input 22 ; DENTSD - This is a Variable that is established before this routine is called. 3 23 ;VERSION 1.2 4 24 S DENTC=0,DENTSD=DENTSD-.0001,%ZIS="MQ" K IO("Q") D ^%ZIS G EXIT1:IO="" … … 7 27 RPT F I=0:1 S DENTSD=$O(^DENT(221,"A1",DENTSTA,DENTSD)) Q:DENTSD>DENTED!(DENTSD="") D:'I HDR^DENTA16 S DENT="" F J=0:0 S DENT=$O(^DENT(221,"A1",DENTSTA,DENTSD,DENT)) Q:DENT="" I $D(^DENT(221,DENT,0)) S X=^(0) D HDR1 Q:Z5=U D P1 Q:Z5=U 8 28 Q 9 P1 I $D(DENTREL) Q:'$D(^DENT(221,DENT,1)) S Y(1)=$P(^(.1),"^",2) I 'Y(1)!<DENTSD1!Y(1)>DENTED Q 29 ; P1 I $D(DENTREL) Q:'$D(^DENT(221,DENT,1)) S Y(1)=$P(^(.1),"^",2) I 'Y(1)!<DENTSD1!Y(1)>DENTED Q 30 ; The expression on the comment above is wrong. I suspect that the meaning is that Y(1) needs to be 31 ; at, or between DENTSD1 and DENTED. This test below will filter out the outer extremes. 32 ; 33 P1 I $D(DENTREL) Q:'$D(^DENT(221,DENT,1)) S Y(1)=$P(^(.1),"^",2) I Y(1)<DENTSD1!(Y(1)>DENTED) Q 10 34 S DENTC=DENTC+1 D CHK^DENTA15 Q:DENTF 11 35 I $P(X,U,27) S K=$S($P(X,U,27)=1:35,1:37) W ?46,$E($P(^DIC(220.3,K,0),U,1),1,30),?79,1,! D:IOSL-($Y#IOSL)<4 HOLD1 Q 12 36 I $P(X,U,44) W ?46,$E($P(^DIC(220.3,36,0),U,1),1,30),?79,1,! W:$P(X,U,45) ?46,$E($P(^DIC(220.3,38,0),U,1),1,30),?79,$P(X,U,45),! D:IOSL-($Y#IOSL)<4 HOLD1 Q 13 37 I $P(X,U,41) W ?46,$E($P(^DIC(220.3,$P(X,U,41),0),U,1),1,30),?79,1,! D:IOSL-($Y#IOSL)<4 HOLD1 Q:Z5=U 14 I $P(X,U,8) W ?46,"ADMINISTRATIVE PROCEDURE",?79,1,!D:IOSL-($Y#IOSL)<4 HOLD1 Q:Z5=U38 I $P(X,U,8) W ?46,"ADMINISTRATIVE PROCEDURE",?79,1,! D:IOSL-($Y#IOSL)<4 HOLD1 Q:Z5=U 15 39 I $P(X,U,7)'="" S X(2)=$S($P(X,U,7)="S":"4",1:"5") W ?46,$E($P(^DIC(220.3,X(2),0),U,1),1,30),?79,1,! D:IOSL-($Y#IOSL)<4 HOLD1 Q:Z5=U 16 40 F K=9,11:1:18,20,22:1:26,28:1:38,42:1:43 I $P(X,U,K) D W Q:Z5=U
Note:
See TracChangeset
for help on using the changeset viewer.