DENTA11 ;ISC2/SAW,HAG-TREATMENT DATA SUMMARY REPORT BY PROVIDER ; 4/4/89 11:32 AM ;
;VERSION 1.2
A S (DENT3,DENT4)="" 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,A4:%=1
A1 W !!,"Would you like to review released data only" S %=2 D YN^DICN D:%=0 Q1^DENTA12 G A1:%=0,EXIT:%<0 S:%=1 DENTREL=1
A2 R !!,"Select starting PROVIDER NUMBER: ",X:DTIME D:X["?" F G A2:X["?",EXIT:X=""!(X=U) W:X'?4N *7,?($X+1),"?" G:X'?4N A2 S DENTPRV=X
A3 R !,"Select ending PROVIDER NUMBER: ",X:DTIME D:X["?" F G A3:X["?",EXIT:X=""!(X=U) W:X'?4N *7,?($X+1),"?" G:X'?4N A3 S DENTPRV1=X,EP=1
A4 W !!,"Do you wish to print the optional 3rd page of the summary" S %=2 D YN^DICN D:%=0 Q5^DENTQ G A4:%=0,EXIT:%<0,A6:%=2 S DENT3=1
A5 W !!,"Do you wish to see the $VALUE on this 3rd page" S %=2 D YN^DICN D:%=0 Q6^DENTQ G A5:%=0,EXIT:%<0 S:%=1 DENT4=1
A6 S %ZIS="MQ" K IO("Q") D ^%ZIS G EXIT:IO=""
I $D(IO("Q")) S ZTRTN="QUE^DENTA11",ZTSAVE("DENT*")="",ZTSAVE("EP")="",ZTSAVE("H1")="",ZTSAVE("H2")="",ZTSAVE("U")="",ZTSAVE("Z5")="" D ^%ZTLOAD K ZTSK,ZTRTN,ZTSAVE G EXIT
QUE U IO S DENTPRV1=$S($D(DENTPRV1):DENTPRV1,1:""),DENTPRV=$S($D(DENTPRV):DENTPRV-1,1:""),DENTC=0,DENTSD=DENTSD-.0001 S:$L(DENTPRV)<4&(DENTPRV]"") DENTPRV=$E("000"_DENTPRV,$L(DENTPRV),$L(DENTPRV)+3) S DENTPRV2=DENTPRV
F I=0:0 S DENTSD=$O(^DENT(221,"AC1",DENTSTA,DENTSD)) Q:DENTSD>DENTED!(DENTSD="") S DENTPRV=DENTPRV2 F J=0:0 S DENTPRV=$O(^DENT(221,"AC1",DENTSTA,DENTSD,DENTPRV)) Q:DENTPRV="" Q:(DENTPRV>DENTPRV1)&($D(EP)) D RPT
D ^DENTA15 G CLOSE
RPT S:'$D(^UTILITY($J,"DENTR",DENTPRV)) ^UTILITY($J,"DENTR",DENTPRV)="" S DENT="",DENTC(1)=0 F K=0:0 S DENT=$O(^DENT(221,"AC1",DENTSTA,DENTSD,DENTPRV,DENT)) Q:DENT="" D:$D(^DENT(221,DENT,0)) P1
S ^UTILITY($J,"DENTR",DENTPRV)=^UTILITY($J,"DENTR",DENTPRV)+DENTC(1) Q
P1 I $D(DENTREL) Q:'$D(^DENT(221,DENT,.1)) S Y(1)=$P(^(.1),"^",2) I 'Y(1)!Y(1)<DENTSD1!Y(1)>DENTED Q
S DENTC=DENTC+1,X=^DENT(221,DENT,0),DENTF=0,DENTC(1)=DENTC(1)+1
I $P(X,U,27)'=""!($P(X,U,44)'="") D SPOT Q
D CHK^DENTA15 Q:DENTF S DENTCAT=$P(X,U,19)
I $P(X,U,9)!($P(X,U,11)) S ^UTILITY($J,"DENTR",DENTPRV,7,DENTCAT)=$S($D(^UTILITY($J,"DENTR",DENTPRV,7,DENTCAT)):^(DENTCAT)+1,1:1)
I $P(X,U,41) S X(2)=$P(X,U,41),^UTILITY($J,"DENTR",DENTPRV,X(2),DENTCAT)=$S($D(^UTILITY($J,"DENTR",DENTPRV,X(2),DENTCAT)):^(DENTCAT)+1,1:1)
I $P(X,U,8) S ^UTILITY($J,"DENTR",DENTPRV,39,DENTCAT)=$S($D(^UTILITY($J,"DENTR",DENTPRV,39,DENTCAT)):^(DENTCAT)+1,1:1)
I $P(X,U,7)'="" S X(2)=$S($P(X,U,7)="S":"4",1:"5"),^UTILITY($J,"DENTR",DENTPRV,X(2),DENTCAT)=$S($D(^UTILITY($J,"DENTR",DENTPRV,X(2),DENTCAT)):^(DENTCAT)+1,1:1)
F M=9,11:1:18,20,22:1:26,28:1:38,42:1:43 I $P(X,U,M) D P11
Q
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))),$P(^UTILITY($J,"DENTR",DENTPRV,+X(2),DENTCAT),U,1)=$S($D(^UTILITY($J,"DENTR",DENTPRV,+X(2),DENTCAT)):$P(^(DENTCAT),U,1)+X(3),1:+X(3))
I M=36 S $P(^UTILITY($J,"DENTR",DENTPRV,+X(2),DENTCAT),"^",2)=$S($D(^UTILITY($J,"DENTR",DENTPRV,+X(2),DENTCAT)):$P(^(DENTCAT),"^",2)+1,1:1)
Q
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)
D CHK^DENTA15 Q:DENTF S DENTCAT=$P(X,U,19)
S ^UTILITY($J,"DENTR",DENTPRV,X(2),DENTCAT)=$S($D(^UTILITY($J,"DENTR",DENTPRV,X(2),DENTCAT)):^(DENTCAT)+1,1:1)
I $P(X,U,45) S ^UTILITY($J,"DENTR",DENTPRV,38,DENTCAT)=$S($D(^UTILITY($J,"DENTR",DENTPRV,38,DENTCAT)):^(DENTCAT)+$P(X,U,45),1:$P(X,U,45))
Q
F S DIC="^DENT(220.5,",DIC(0)="E" D ^DIC K DIC Q
S ;;;;;;;;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
CLOSE X ^%ZIS("C")
EXIT K %,DENT,DENTCAT,DENTCAT1,DENTDAT,DENTED,DENTF,DENTPRV,DENTPRV2,DENTPRV1,DENTREL,DENTSD,DENT3,DENT4,EP,DIC,I,J,K,M,V,V1,X,Y D:$D(ZTSK) EXIT1^DENTA1 Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDENTA11 3812 printed Nov 22, 2024@16:55:54 Page 2
DENTA11 ;ISC2/SAW,HAG-TREATMENT DATA SUMMARY REPORT BY PROVIDER ; 4/4/89 11:32 AM ;
+1 ;VERSION 1.2
A SET (DENT3,DENT4)=""
WRITE !!,"Would you like to review the data for all providers"
SET %=1
DO YN^DICN
if %=0
DO Q^DENTAR11
if %=0
GOTO A
if %<0
GOTO EXIT
if %=1
GOTO A4
A1 WRITE !!,"Would you like to review released data only"
SET %=2
DO YN^DICN
if %=0
DO Q1^DENTA12
if %=0
GOTO A1
if %<0
GOTO EXIT
if %=1
SET DENTREL=1
A2 READ !!,"Select starting PROVIDER NUMBER: ",X:DTIME
if X["?"
DO F
if X["?"
GOTO A2
if X=""!(X=U)
GOTO EXIT
if X'?4N
WRITE *7,?($X+1),"?"
if X'?4N
GOTO A2
SET DENTPRV=X
A3 READ !,"Select ending PROVIDER NUMBER: ",X:DTIME
if X["?"
DO F
if X["?"
GOTO A3
if X=""!(X=U)
GOTO EXIT
if X'?4N
WRITE *7,?($X+1),"?"
if X'?4N
GOTO A3
SET DENTPRV1=X
SET EP=1
A4 WRITE !!,"Do you wish to print the optional 3rd page of the summary"
SET %=2
DO YN^DICN
if %=0
DO Q5^DENTQ
if %=0
GOTO A4
if %<0
GOTO EXIT
if %=2
GOTO A6
SET DENT3=1
A5 WRITE !!,"Do you wish to see the $VALUE on this 3rd page"
SET %=2
DO YN^DICN
if %=0
DO Q6^DENTQ
if %=0
GOTO A5
if %<0
GOTO EXIT
if %=1
SET DENT4=1
A6 SET %ZIS="MQ"
KILL IO("Q")
DO ^%ZIS
if IO=""
GOTO EXIT
+1 IF $DATA(IO("Q"))
SET ZTRTN="QUE^DENTA11"
SET ZTSAVE("DENT*")=""
SET ZTSAVE("EP")=""
SET ZTSAVE("H1")=""
SET ZTSAVE("H2")=""
SET ZTSAVE("U")=""
SET ZTSAVE("Z5")=""
DO ^%ZTLOAD
KILL ZTSK,ZTRTN,ZTSAVE
GOTO EXIT
QUE USE IO
SET DENTPRV1=$SELECT($DATA(DENTPRV1):DENTPRV1,1:"")
SET DENTPRV=$SELECT($DATA(DENTPRV):DENTPRV-1,1:"")
SET DENTC=0
SET DENTSD=DENTSD-.0001
if $LENGTH(DENTPRV)<4&(DENTPRV]"")
SET DENTPRV=$EXTRACT("000"_DENTPRV,$LENGTH(DENTPRV),$LENGTH(DENTPRV)+3)
SET DENTPRV2=DENTPRV
+1 FOR I=0:0
SET DENTSD=$ORDER(^DENT(221,"AC1",DENTSTA,DENTSD))
if DENTSD>DENTED!(DENTSD="")
QUIT
SET DENTPRV=DENTPRV2
FOR J=0:0
SET DENTPRV=$ORDER(^DENT(221,"AC1",DENTSTA,DENTSD,DENTPRV))
if DENTPRV=""
QUIT
if (DENTPRV>DENTPRV1)&($DATA(EP))
QUIT
DO RPT
+2 DO ^DENTA15
GOTO CLOSE
RPT if '$DATA(^UTILITY($JOB,"DENTR",DENTPRV))
SET ^UTILITY($JOB,"DENTR",DENTPRV)=""
SET DENT=""
SET DENTC(1)=0
FOR K=0:0
SET DENT=$ORDER(^DENT(221,"AC1",DENTSTA,DENTSD,DENTPRV,DENT))
if DENT=""
QUIT
if $DATA(^DENT(221,DENT,0))
DO P1
+1 SET ^UTILITY($JOB,"DENTR",DENTPRV)=^UTILITY($JOB,"DENTR",DENTPRV)+DENTC(1)
QUIT
P1 IF $DATA(DENTREL)
if '$DATA(^DENT(221,DENT,.1))
QUIT
SET Y(1)=$PIECE(^(.1),"^",2)
IF 'Y(1)!Y(1)<DENTSD1!Y(1)>DENTED
QUIT
+1 SET DENTC=DENTC+1
SET X=^DENT(221,DENT,0)
SET DENTF=0
SET DENTC(1)=DENTC(1)+1
+2 IF $PIECE(X,U,27)'=""!($PIECE(X,U,44)'="")
DO SPOT
QUIT
+3 DO CHK^DENTA15
if DENTF
QUIT
SET DENTCAT=$PIECE(X,U,19)
+4 IF $PIECE(X,U,9)!($PIECE(X,U,11))
SET ^UTILITY($JOB,"DENTR",DENTPRV,7,DENTCAT)=$SELECT($DATA(^UTILITY($JOB,"DENTR",DENTPRV,7,DENTCAT)):^(DENTCAT)+1,1:1)
+5 IF $PIECE(X,U,41)
SET X(2)=$PIECE(X,U,41)
SET ^UTILITY($JOB,"DENTR",DENTPRV,X(2),DENTCAT)=$SELECT($DATA(^UTILITY($JOB,"DENTR",DENTPRV,X(2),DENTCAT)):^(DENTCAT)+1,1:1)
+6 IF $PIECE(X,U,8)
SET ^UTILITY($JOB,"DENTR",DENTPRV,39,DENTCAT)=$SELECT($DATA(^UTILITY($JOB,"DENTR",DENTPRV,39,DENTCAT)):^(DENTCAT)+1,1:1)
+7 IF $PIECE(X,U,7)'=""
SET X(2)=$SELECT($PIECE(X,U,7)="S":"4",1:"5")
SET ^UTILITY($JOB,"DENTR",DENTPRV,X(2),DENTCAT)=$SELECT($DATA(^UTILITY($JOB,"DENTR",DENTPRV,X(2),DENTCAT)):^(DENTCAT)+1,1:1)
+8 FOR M=9,11:1:18,20,22:1:26,28:1:38,42:1:43
IF $PIECE(X,U,M)
DO P11
+9 QUIT
P11 SET X(2)=$PIECE($TEXT(S),";",M)
SET X(3)=$PIECE(X,U,M)
SET X(3)=0_X(3)
SET X(3)=$EXTRACT(X(3),($LENGTH(X(3))-1),$LENGTH(X(3)))
SET $PIECE(^UTILITY($JOB,"DENTR",DENTPRV,+X(2),DENTCAT),U,1)=$SELECT($DATA(^UTILITY($JOB,"DENTR",DENTPRV,+X(2),DENTCAT)):$PIECE(^(DENTCAT),U,1)+X(3),1:+X(3))
+1 IF M=36
SET $PIECE(^UTILITY($JOB,"DENTR",DENTPRV,+X(2),DENTCAT),"^",2)=$SELECT($DATA(^UTILITY($JOB,"DENTR",DENTPRV,+X(2),DENTCAT)):$PIECE(^(DENTCAT),"^",2)+1,1:1)
+2 QUIT
SPOT SET X(1)=$SELECT($PIECE(X,U,44)'="":$PIECE(X,U,44),1:$PIECE(X,U,27))
SET X(2)=$SELECT(X(1)=1:35,X(1)=2:36,1:37)
+1 DO CHK^DENTA15
if DENTF
QUIT
SET DENTCAT=$PIECE(X,U,19)
+2 SET ^UTILITY($JOB,"DENTR",DENTPRV,X(2),DENTCAT)=$SELECT($DATA(^UTILITY($JOB,"DENTR",DENTPRV,X(2),DENTCAT)):^(DENTCAT)+1,1:1)
+3 IF $PIECE(X,U,45)
SET ^UTILITY($JOB,"DENTR",DENTPRV,38,DENTCAT)=$SELECT($DATA(^UTILITY($JOB,"DENTR",DENTPRV,38,DENTCAT)):^(DENTCAT)+$PIECE(X,U,45),1:$PIECE(X,U,45))
+4 QUIT
F SET DIC="^DENT(220.5,"
SET DIC(0)="E"
DO ^DIC
KILL DIC
QUIT
S ;;;;;;;;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
CLOSE XECUTE ^%ZIS("C")
EXIT KILL %,DENT,DENTCAT,DENTCAT1,DENTDAT,DENTED,DENTF,DENTPRV,DENTPRV2,DENTPRV1,DENTREL,DENTSD,DENT3,DENT4,EP,DIC,I,J,K,M,V,V1,X,Y
if $DATA(ZTSK)
DO EXIT1^DENTA1
QUIT
