[613] | 1 | DENTAR12 ;ISC2/SAW,HAG-REVIEW/RELEASE TREATMENT REPORT - SITTINGS BY PROVIDER ; 12/2/88 6:49 PM ;
|
---|
| 2 | ;VERSION 1.2
|
---|
| 3 | A W !!,"Would you like to review the data for all providers" S %=1 D YN^DICN D:%=0 Q^DENTAR11 G A:%=0,EXIT:%<0
|
---|
| 4 | I %=2 S DIC="^DENT(220.5,",DIC(0)="AEQMZ" D ^DIC G EXIT:Y<0 K DIC S DENTPRV=$P(Y(0),U,2)
|
---|
| 5 | S %ZIS="MQ" K IO("Q") D ^%ZIS G EXIT:IO=""
|
---|
| 6 | I $D(IO("Q")) S ZTRTN="QUE^DENTAR12",ZTSAVE("DENT*")="",ZTSAVE("H*")="",ZTSAVE("U")="",ZTSAVE("Z")="",ZTSAVE("Z1")="",ZTSAVE("Z2")="",ZTSAVE("Z3")="",ZTSAVE("Z4")="",ZTSAVE("Z5")="" D ^%ZTLOAD K ZTSK,ZTRTN,ZTSAVE G EXIT
|
---|
| 7 | QUE U IO S DENTPRV1=$S($D(DENTPRV):DENTPRV,1:""),DENTPRV=$S($D(DENTPRV):DENTPRV-1,1:""),(DENTC(1),DENTC)=0,DENTSD=DENTSD-.0001,Q=1
|
---|
| 8 | S:$L(DENTPRV)<4&(DENTPRV]"") DENTPRV=$E("000"_DENTPRV,$L(DENTPRV),$L(DENTPRV)+3) S DENTPRV2=DENTPRV,DT1=$E(DT,1,5)_"08"
|
---|
| 9 | F I=0:0 S DENTSD=$O(^DENT(221,"AC",Z3,DENTSD)) Q:DENTSD>DENTED!(DENTSD="")!(DT<DT1&($E(DENTSD,1,5)=$E(DT,1,5))) S DENTPRV=DENTPRV2 F J=0:0 S DENTPRV=$O(^DENT(221,"AC",Z3,DENTSD,DENTPRV)) Q:$S(DENTPRV1="":DENTPRV="",1:DENTPRV'=DENTPRV1) D RPT
|
---|
| 10 | K DENTCAT,DENTPRV1,DENTPRV2,DENTF,DENTSD,X,Z1,Z2 D ^DENTAR16 G EXIT
|
---|
| 11 | RPT S DENT="" F K=0:0 S DENT=$O(^DENT(221,"AC",Z3,DENTSD,DENTPRV,DENT)) Q:DENT="" D:$D(^DENT(221,DENT,0)) P1
|
---|
| 12 | Q
|
---|
| 13 | P1 I $D(^DENT(221,DENT,.1)),$P(^(.1),U,1) Q
|
---|
| 14 | S DENTC=DENTC+1,X=^DENT(221,DENT,0),DENTF=0 I '$D(DENTF1) S ^UTILITY($J,"DENTP",DENT)=DENTSD_","_DENTPRV I 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
|
---|
| 15 | I $P(X,U,27)'=""!($P(X,U,44)'="") D SPOT Q
|
---|
| 16 | D CHK^DENTAR15 Q:DENTF S DENTCAT=$P(X,U,19)
|
---|
| 17 | I IO=IO(0),'$D(DENTF1),'$D(DENTV) D DENTV^DENTAR13
|
---|
| 18 | I $P(X,U,41) S X(2)=0_$P(X,U,41),^UTILITY($J,"DENTR",DENTPRV,DENT)=$S($D(^UTILITY($J,"DENTR",DENTPRV,DENT)):^(DENT)_U_+X(2)_U_1,1:+X(2)_U_1) I IO=IO(0),'$D(DENTF1) S DENTV=DENTV_X(2)_"01"
|
---|
| 19 | I $P(X,U,8) S ^UTILITY($J,"DENTR",DENTPRV,DENT)=$S($D(^UTILITY($J,"DENTR",DENTPRV,DENT)):^(DENT)_U_39_U_1,1:39_U_1) I IO=IO(0),'$D(DENTF1) S DENTV=DENTV_3501
|
---|
| 20 | I $P(X,U,7)'="" S X(2)=$S($P(X,U,7)="S":"04",1:"05"),^UTILITY($J,"DENTR",DENTPRV,DENT)=$S($D(^UTILITY($J,"DENTR",DENTPRV,DENT)):^(DENT)_U_+X(2)_U_1,1:+X(2)_U_1)
|
---|
| 21 | I $P(X,U,7)'="",IO=IO(0),'$D(DENTF1) S DENTV=DENTV_X(2)_"01"
|
---|
| 22 | F M=9,11:1:18,20,22:1:26,28:1:38,42:1:43 I $P(X,U,M) D P11
|
---|
| 23 | I IO=IO(0),'$D(DENTF1) S DENTV=DENTV_" ",^UTILITY($J,"DENTV",Q,DENTC,0)=$E(DENTV,1,80) K DENTV
|
---|
| 24 | I '$D(^UTILITY($J,"DENTR",DENTPRV,DENT)) S ^(DENT)=""
|
---|
| 25 | Q
|
---|
| 26 | P11 S X(2)=$P($T(S),";",M),X(3)=$P(X,U,M),X(3)=0_X(3),X(3)=$E(X(3),($L(X(3))-1),$L(X(3))),^UTILITY($J,"DENTR",DENTPRV,DENT)=$S($D(^UTILITY($J,"DENTR",DENTPRV,DENT)):^(DENT)_U_+X(2)_U_+X(3),1:+X(2)_U_+X(3))
|
---|
| 27 | I IO=IO(0),'$D(DENTF1) S DENTV=DENTV_X(2)_X(3)
|
---|
| 28 | Q
|
---|
| 29 | SPOT S X(1)=$S($P(X,U,44)'="":$P(X,U,44),1:$P(X,U,27)),X(2)=$S(X(1)=1:35,X(1)=2:36,1:37)
|
---|
| 30 | D CHK^DENTAR15 Q:DENTF S DENTCAT=$P(X,U,19)
|
---|
| 31 | S ^UTILITY($J,"DENTR",DENTPRV,DENT)=$S($D(^UTILITY($J,"DENTR",DENTPRV,DENT)):^(DENT)_U_X(2)_U_1,1:X(2)_U_1)
|
---|
| 32 | I $P(X,U,45) S ^UTILITY($J,"DENTR",DENTPRV,DENT)=$S($D(^UTILITY($J,"DENTR",DENTPRV,DENT)):^(DENT)_U_38_U_$P(X,U,45),1:38_U_$P(X,U,45))
|
---|
| 33 | S DENTCAT="00"_DENTCAT,DENTCAT=$E(DENTCAT,($L(DENTCAT)-2),$L(DENTCAT)),DENTDAT=$P(X,U,1),DENTDAT=$E(DENTDAT,4,5)_$E(DENTDAT,6,7)_$E(DENTDAT,2,3)
|
---|
| 34 | I IO=IO(0),'$D(DENTF1) S ^UTILITY($J,"DENTV",Q,DENTC,0)=2_DENTSTA_$P(X,U,10)_$P(X,U,2)_"0000"_DENTDAT_DENTCAT_X(1)_$S(X(1)=2:" ",$P(X,U,45)="":0,1:$P(X,U,45))_" "
|
---|
| 35 | Q
|
---|
| 36 | S ;;;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
|
---|
| 37 | EXIT X ^%ZIS("C") K %,DENT,DENTCAT,DENTCAT1,DENTDAT,DENTED,DENTF,DENTPRV,DENTPRV1,DENTPRV2,DENTSD,DIC,I,J,K,M,X,Y D:$D(ZTSK) EXIT1^DENTAR1 Q
|
---|