source: FOIAVistA/trunk/r/DENTAL-DEN/DENTAR14.m@ 1713

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

initial load of FOIAVistA 6/30/08 version
File size: 3.6 KB
Line 
1DENTAR14 ;ISC2/SAW,HAG-REVIEW/RELEASE TREATMENT DATA REPORT - INDIVIDUAL SITTINGS ; 10/27/88 10:15 AM ;
2 ;VERSION 1.2
3 S %ZIS="MQ" K IO("Q") D ^%ZIS G EXIT1:IO=""
4 I $D(IO("Q")) S ZTRTN="QUE^DENTAR14",ZTSAVE("DENT*")="",ZTSAVE("DT")="",ZTSAVE("U")="",ZTSAVE("Z3")="",ZTSAVE("Z5")="",ZTSAVE("H*")="" D ^%ZTLOAD K ZTSK,ZTRTN,ZTSAVE G EXIT1
5QUE U IO S (DENTC(1),DENTC)=0,DENTSD=DENTSD-.0001,Q=1,DT1=$E(DT,1,5)_"08" D RPT G NONE:'DENTC D:Z5'=U HOLD S:Z5=U DENTF1=1 G EXIT
6RPT F I=0:1 S DENTSD=$O(^DENT(221,"A",Z3,DENTSD)) Q:DENTSD>DENTED!(DENTSD="")!(DT<DT1&($E(DENTSD,1,5)=$E(DT,1,5))) D RPT1
7 Q
8RPT1 D:'I HDR^DENTAR16 S DENT="" F J=0:0 S DENT=$O(^DENT(221,"A",Z3,DENTSD,DENT)) Q:DENT="" I $D(^DENT(221,DENT,0)) S X=^(0) D HDR1 Q:Z5=U D P1 Q:Z5=U
9 Q
10P1 I $D(^DENT(221,DENT,.1)),$P(^(.1),U,1) Q
11 S DENTC=DENTC+1 D CHK^DENTAR15 Q:DENTF S:'$D(DENTF1) ^UTILITY($J,"DENTP",DENT)=DENTSD
12 I '$D(DENTF1),DENTC=181 S:IO=IO(0) ^UTILITY($J,"DENTV",Q,DENTC-1,0)=^UTILITY($J,"DENTV",Q,DENTC-1,0)_"$" S Q=Q+1,DENTC(1)=DENTC(1)+180,DENTC=1
13 S DENTCAT=$P(X,U,19),DENTCAT="00"_DENTCAT,DENTCAT=$E(DENTCAT,$L(DENTCAT)-1,$L(DENTCAT))
14 I IO=IO(0),'$D(DENTF1),'$D(DENTV) D DENTV
15 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:Z5=U S X(1)=$P(X,U,27) D SPOT Q
16 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:Z5=U S X(1)=$P(X,U,44) D SPOT Q
17 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 S X(2)=0_$P(X,U,41) I IO=IO(0),'$D(DENTF1) S DENTV=DENTV_X(2)_"01"
18 I $P(X,U,8) W ?46,"ADMINISTRATIVE PROCEDURE",?79,1,! D:IOSL-($Y#IOSL)<4 HOLD1 Q:Z5=U I IO=IO(0),'$D(DENTF1) S DENTV=DENTV_3501
19 I $P(X,U,7)'="" S X(2)=$S($P(X,U,7)="S":"04",1:"05") 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 I IO=IO(0),'$D(DENTF1) S DENTV=DENTV_X(2)_"01"
20 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
21 I IO=IO(0),'$D(DENTF1) S $P(X1," ",51)=" ",DENTV=DENTV_X1,^UTILITY($J,"DENTV",Q,DENTC,0)=$E(DENTV,1,80) K X1,DENTV
22 Q
23W W ?46,$E($P(^DIC(220.3,+$P($T(S),";",K),0),U,1),1,30),?77,$J($P(X,U,K),3),! D:IOSL-($Y#IOSL)<4 HOLD1 Q:Z5=U
24 I IO=IO(0),'$D(DENTF1) S X(2)=$P($T(S),";",K),X(3)=$P(X,U,K),X(3)=0_X(3),X(3)=$E(X(3),($L(X(3))-1),$L(X(3))),DENTV=DENTV_X(2)_X(3)
25 Q
26SPOT I IO=IO(0),'$D(DENTF1) S DENTDAT=$P(X,U,1),DENTDAT=$E(DENTDAT,4,5)_$E(DENTDAT,6,7)_$E(DENTDAT,2,3)
27 Q
28HDR1 I IOSL-($Y#IOSL)<4 D HOLD Q:Z5=U D HDR^DENTAR16
29 S Y=$P(X,U,1) X ^DD("DD") W !,Y,?19,$P(X,U,10),?25,$P(X,U,2),?36,$J($P(X,U,19),2),?41 W:$P(X,U,19)<9 $J($P(X,U,6),2) Q
30DENTV S X(1)=$P(X,U,6),X(1)=$S(X(1)="":" ",1:0_X(1)),X(1)=$E(X(1),$L(X(1))-1,$L(X(1))),DENTDAT=$P(X,U,1),DENTDAT=$E(DENTDAT,4,5)_$E(DENTDAT,6,7)_$E(DENTDAT,2,3)
31 S DENTV=1_DENTSTA_$P(X,U,10)_$E($P(X,U,2),1,9)_DENTCAT_X(1)_DENTDAT Q
32HOLD Q:$D(ZTSK)!(IO'=IO(0))!(Z5=U) S Z5="" R !,"Press return to continue, uparrow (^) to exit: ",Z5:DTIME Q
33HOLD1 D HOLD D:Z5'=U HDR^DENTAR16 Q
34NONE S DENTF1=1 W !,"There is no treatment data for review/release for the time frame you specified",*7 G EXIT1
35EXIT G EXIT1:Z5=U I $D(DENTF1) W @IOF,*7 D ERR^DENTAR16 S H="" F I=1:1 Q:Z5=U S H=$O(^UTILITY($J,"DENTERR",H)) Q:H="" F J=1:1:5 D:IOSL-($Y#IOSL)<4 HOLD Q:Z5=U W:$D(^UTILITY($J,"DENTERR",H,J)) !,^(J)
36 D:'$D(DENTF1) COMP^DENTAR16 W ! D:$D(DENTF1)&(Z5'=U) HOLD
37EXIT1 X ^%ZIS("C") K DENT,DENTCAT,DENTDAT,DENTED,DENTF,DENTSD,H,H1,H2,H3,I,J,K,X D:$D(ZTSK) EXIT1^DENTAR1 Q
38S ;;;04;05;;;;08;;09;15;16;33;10;20;21;22;;23;;11;12;13;14;17;;24;25;26;27;28;29;30;31;18;19;32;;;;34;06
Note: See TracBrowser for help on using the repository browser.