DENTAR13 ;ISC2/SAW,HAG-REVIEW/RELEASE TREATMENT DATA SUMMARY REPORT FOR CLINIC ; 10/27/88 10:33 AM ;
;VERSION 1.2
S %ZIS="MQ" K IO("Q") D ^%ZIS G EXIT:IO=""
I $D(IO("Q")) S ZTRTN="QUE^DENTAR13",ZTSAVE("DENT*")="",ZTSAVE("H*")="",ZTSAVE("U")="",ZTSAVE("Z")="",ZTSAVE("Z1")="",ZTSAVE("Z2")="",ZTSAVE("Z3")="",ZTSAVE("Z4")="",ZTSAVE("Z5")="" D ^%ZTLOAD K ZTSK,ZTRTN,ZTSAV G EXIT
QUE U IO S (DENTC(1),DENTC)=0,DENTSD=DENTSD-.0001,Q=1,DT1=$E(DT,1,5)_"08" D RPT G NONE:'DENTC D A^DENTAR15 G EXIT
RPT F I=0:0 S DENTSD=$O(^DENT(221,"A",Z3,DENTSD)) Q:DENTSD>DENTED!(DENTSD="")!(DT<DT1&($E(DENTSD,1,5)=$E(DT,1,5))) S DENT="" F K=0:0 S DENT=$O(^DENT(221,"A",Z3,DENTSD,DENT)) Q:DENT="" D:$D(^DENT(221,DENT,0)) P1
Q
P1 I $D(^DENT(221,DENT,.1)),$P(^(.1),U,1) Q
S DENTC=DENTC+1,X=^DENT(221,DENT,0) I '$D(DENTF1) S ^UTILITY($J,"DENTP",DENT)=DENTSD 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
I $P(X,U,27)'=""!($P(X,U,44)'="") D SPOT Q
P1A D CHK^DENTAR15 Q:DENTF S DENTCAT=$P(X,U,19)
I IO=IO(0),'$D(DENTF1),'$D(DENTV) D DENTV
I $P(X,U,41) S X(2)=0_$P(X,U,41),^UTILITY($J,"DENTR",+X(2),DENTCAT)=$S($D(^UTILITY($J,"DENTR",+X(2),DENTCAT)):^(DENTCAT)+1,1:1) I IO=IO(0),'$D(DENTF1) S DENTV=DENTV_X(2)_"01"
I $P(X,U,8) S ^UTILITY($J,"DENTR",39,DENTCAT)=$S($D(^UTILITY($J,"DENTR",39,DENTCAT)):^(DENTCAT)+1,1:1) I IO=IO(0),'$D(DENTF1) S DENTV=DENTV_3501
I $P(X,U,7)'="" S X(2)=$S($P(X,U,7)="S":"04",1:"05"),^UTILITY($J,"DENTR",+X(2),DENTCAT)=$S($D(^UTILITY($J,"DENTR",+X(2),DENTCAT)):^(DENTCAT)+1,1:1)
I $P(X,U,7)'="",IO=IO(0),'$D(DENTF1) S DENTV=DENTV_X(2)_"01"
F M=9,11:1:18,20,22:1:26,28:1:38,42:1:43 I $P(X,U,M) D P11
I IO=IO(0),'$D(DENTF1) S DENTV=DENTV_" ",^UTILITY($J,"DENTV",Q,DENTC,0)=$E(DENTV,1,80) K DENTV
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))),^UTILITY($J,"DENTR",+X(2),DENTCAT)=$S($D(^UTILITY($J,"DENTR",+X(2),DENTCAT)):^(DENTCAT)+X(3),1:+X(3))
I IO=IO(0),'$D(DENTF1) S DENTV=DENTV_X(2)_X(3)
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^DENTAR15 Q:DENTF S DENTCAT=$P(X,U,19)
S ^UTILITY($J,"DENTR",X(2),DENTCAT)=$S($D(^UTILITY($J,"DENTR",X(2),DENTCAT)):^(DENTCAT)+1,1:1)
I $P(X,U,45) S ^UTILITY($J,"DENTR",38,DENTCAT)=$S($D(^UTILITY($J,"DENTR",38,DENTCAT)):^(DENTCAT)+$P(X,U,45),1:$P(X,U,45))
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)
I IO=IO(0),'$D(DENTF1) S ^UTILITY($J,"DENTV",Q,DENTC,0)=$S($P(X,U,5)="D":"C",1:2)_DENTSTA_$P(X,U,10)_$E($P(X,U,2),1,9)_"0000"_DENTDAT_DENTCAT_X(1)_$S(X(1)=2:" ",$P(X,U,45)="":0,1:$P(X,U,45))_" "
Q
DENTV 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)
S DENTCAT1="00"_DENTCAT,DENTCAT1=$E(DENTCAT1,$L(DENTCAT1)-1,$L(DENTCAT1))
S DENTV=$S($P(X,U,5)="C":6,$P(X,U,5)="D":"B",1:1)_DENTSTA_$P(X,U,10)_$E($P(X,U,2),1,9)_DENTCAT1_X(1)_DENTDAT Q
NONE S DENTF1=1 W !,"There is no treatment data for review/release for the time frame you specified",*7 G EXIT
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
EXIT X ^%ZIS("C") K DENT,DENTCAT,DENTCAT1,DENTDAT,DENTED,DENTSD,I,K,M,X D:$D(ZTSK) EXIT1^DENTAR1 Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDENTAR13 3531 printed Dec 13, 2024@01:45:57 Page 2
DENTAR13 ;ISC2/SAW,HAG-REVIEW/RELEASE TREATMENT DATA SUMMARY REPORT FOR CLINIC ; 10/27/88 10:33 AM ;
+1 ;VERSION 1.2
+2 SET %ZIS="MQ"
KILL IO("Q")
DO ^%ZIS
if IO=""
GOTO EXIT
+3 IF $DATA(IO("Q"))
SET ZTRTN="QUE^DENTAR13"
SET ZTSAVE("DENT*")=""
SET ZTSAVE("H*")=""
SET ZTSAVE("U")=""
SET ZTSAVE("Z")=""
SET ZTSAVE("Z1")=""
SET ZTSAVE("Z2")=""
SET ZTSAVE("Z3")=""
SET ZTSAVE("Z4")=""
SET ZTSAVE("Z5")=""
DO ^%ZTLOAD
KILL ZTSK,ZTRTN,ZTSAV
GOTO EXIT
QUE USE IO
SET (DENTC(1),DENTC)=0
SET DENTSD=DENTSD-.0001
SET Q=1
SET DT1=$EXTRACT(DT,1,5)_"08"
DO RPT
if 'DENTC
GOTO NONE
DO A^DENTAR15
GOTO EXIT
RPT FOR I=0:0
SET DENTSD=$ORDER(^DENT(221,"A",Z3,DENTSD))
if DENTSD>DENTED!(DENTSD="")!(DT<DT1&($EXTRACT(DENTSD,1,5)=$EXTRACT(DT,1,5)))
QUIT
SET DENT=""
FOR K=0:0
SET DENT=$ORDER(^DENT(221,"A",Z3,DENTSD,DENT))
if DENT=""
QUIT
if $DATA(^DENT(221,DENT,0))
DO P1
+1 QUIT
P1 IF $DATA(^DENT(221,DENT,.1))
IF $PIECE(^(.1),U,1)
QUIT
+1 SET DENTC=DENTC+1
SET X=^DENT(221,DENT,0)
IF '$DATA(DENTF1)
SET ^UTILITY($JOB,"DENTP",DENT)=DENTSD
IF DENTC=181
if IO=IO(0)
SET ^UTILITY($JOB,"DENTV",Q,DENTC-1,0)=^UTILITY($JOB,"DENTV",Q,DENTC-1,0)_"$"
SET Q=Q+1
SET DENTC(1)=DENTC(1)+180
SET DENTC=1
+2 IF $PIECE(X,U,27)'=""!($PIECE(X,U,44)'="")
DO SPOT
QUIT
P1A DO CHK^DENTAR15
if DENTF
QUIT
SET DENTCAT=$PIECE(X,U,19)
+1 IF IO=IO(0)
IF '$DATA(DENTF1)
IF '$DATA(DENTV)
DO DENTV
+2 IF $PIECE(X,U,41)
SET X(2)=0_$PIECE(X,U,41)
SET ^UTILITY($JOB,"DENTR",+X(2),DENTCAT)=$SELECT($DATA(^UTILITY($JOB,"DENTR",+X(2),DENTCAT)):^(DENTCAT)+1,1:1)
IF IO=IO(0)
IF '$DATA(DENTF1)
SET DENTV=DENTV_X(2)_"01"
+3 IF $PIECE(X,U,8)
SET ^UTILITY($JOB,"DENTR",39,DENTCAT)=$SELECT($DATA(^UTILITY($JOB,"DENTR",39,DENTCAT)):^(DENTCAT)+1,1:1)
IF IO=IO(0)
IF '$DATA(DENTF1)
SET DENTV=DENTV_3501
+4 IF $PIECE(X,U,7)'=""
SET X(2)=$SELECT($PIECE(X,U,7)="S":"04",1:"05")
SET ^UTILITY($JOB,"DENTR",+X(2),DENTCAT)=$SELECT($DATA(^UTILITY($JOB,"DENTR",+X(2),DENTCAT)):^(DENTCAT)+1,1:1)
+5 IF $PIECE(X,U,7)'=""
IF IO=IO(0)
IF '$DATA(DENTF1)
SET DENTV=DENTV_X(2)_"01"
+6 FOR M=9,11:1:18,20,22:1:26,28:1:38,42:1:43
IF $PIECE(X,U,M)
DO P11
+7 IF IO=IO(0)
IF '$DATA(DENTF1)
SET DENTV=DENTV_" "
SET ^UTILITY($JOB,"DENTV",Q,DENTC,0)=$EXTRACT(DENTV,1,80)
KILL DENTV
+8 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 ^UTILITY($JOB,"DENTR",+X(2),DENTCAT)=$SELECT($DATA(^UTILITY($JOB,"DENTR",+X(2),DENTCAT)):^(DENTCAT)+X(3),1:+X(3))
+1 IF IO=IO(0)
IF '$DATA(DENTF1)
SET DENTV=DENTV_X(2)_X(3)
+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^DENTAR15
if DENTF
QUIT
SET DENTCAT=$PIECE(X,U,19)
+2 SET ^UTILITY($JOB,"DENTR",X(2),DENTCAT)=$SELECT($DATA(^UTILITY($JOB,"DENTR",X(2),DENTCAT)):^(DENTCAT)+1,1:1)
+3 IF $PIECE(X,U,45)
SET ^UTILITY($JOB,"DENTR",38,DENTCAT)=$SELECT($DATA(^UTILITY($JOB,"DENTR",38,DENTCAT)):^(DENTCAT)+$PIECE(X,U,45),1:$PIECE(X,U,45))
+4 SET DENTCAT="00"_DENTCAT
SET DENTCAT=$EXTRACT(DENTCAT,($LENGTH(DENTCAT)-2),$LENGTH(DENTCAT))
SET DENTDAT=$PIECE(X,U,1)
SET DENTDAT=$EXTRACT(DENTDAT,4,5)_$EXTRACT(DENTDAT,6,7)_$EXTRACT(DENTDAT,2,3)
+5 IF IO=IO(0)
IF '$DATA(DENTF1)
SET ^UTILITY($JOB,"DENTV",Q,DENTC,0)=$SELECT($PIECE(X,U,5)="D":"C",1:2)_DENTSTA_$PIECE(X,U,10)_$EXTRACT($PIECE(X,U,2),1,9)_"0000"_DENTDAT_DENTCAT_X(1)_$SELECT(X(1)=2:" ",$PIECE(X,U,45)="":0,1:...
... $PIECE(X,U,45))_" "
+6 QUIT
DENTV SET X(1)=$PIECE(X,U,6)
SET X(1)=$SELECT(X(1)="":" ",1:0_X(1))
SET X(1)=$EXTRACT(X(1),$LENGTH(X(1))-1,$LENGTH(X(1)))
SET DENTDAT=$PIECE(X,U,1)
SET DENTDAT=$EXTRACT(DENTDAT,4,5)_$EXTRACT(DENTDAT,6,7)_$EXTRACT(DENTDAT,2,3)
+1 SET DENTCAT1="00"_DENTCAT
SET DENTCAT1=$EXTRACT(DENTCAT1,$LENGTH(DENTCAT1)-1,$LENGTH(DENTCAT1))
+2 SET DENTV=$SELECT($PIECE(X,U,5)="C":6,$PIECE(X,U,5)="D":"B",1:1)_DENTSTA_$PIECE(X,U,10)_$EXTRACT($PIECE(X,U,2),1,9)_DENTCAT1_X(1)_DENTDAT
QUIT
NONE SET DENTF1=1
WRITE !,"There is no treatment data for review/release for the time frame you specified",*7
GOTO EXIT
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
EXIT XECUTE ^%ZIS("C")
KILL DENT,DENTCAT,DENTCAT1,DENTDAT,DENTED,DENTSD,I,K,M,X
if $DATA(ZTSK)
DO EXIT1^DENTAR1
QUIT
