DENTAR14.m

DENTAR14 ;ISC2/SAW,HAG-REVIEW/RELEASE TREATMENT DATA REPORT - INDIVIDUAL SITTINGS ; 10/27/88  10:15 AM ;

 ;VERSION 1.2

 S %ZIS="MQ" K IO("Q") D ^%ZIS G EXIT1:IO=""

 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

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:Z5'=U HOLD S:Z5=U DENTF1=1 G EXIT

RPT 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

 Q

RPT1 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

 Q

P1 I $D(^DENT(221,DENT,.1)),$P(^(.1),U,1) Q

 S DENTC=DENTC+1 D CHK^DENTAR15 Q:DENTF  S:'$D(DENTF1) ^UTILITY($J,"DENTP",DENT)=DENTSD

 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

 S DENTCAT=$P(X,U,19),DENTCAT="00"_DENTCAT,DENTCAT=$E(DENTCAT,$L(DENTCAT)-1,$L(DENTCAT))

 I IO=IO(0),'$D(DENTF1),'$D(DENTV) D DENTV

 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

 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

 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"

 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

 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"

 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

 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

 Q

W 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

 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)

 Q

SPOT 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)

 Q

HDR1 I IOSL-($Y#IOSL)<4 D HOLD Q:Z5=U  D HDR^DENTAR16

 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

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 DENTV=1_DENTSTA_$P(X,U,10)_$E($P(X,U,2),1,9)_DENTCAT_X(1)_DENTDAT Q

HOLD Q:$D(ZTSK)!(IO'=IO(0))!(Z5=U)  S Z5="" R !,"Press return to continue, uparrow (^) to exit: ",Z5:DTIME Q

HOLD1 D HOLD D:Z5'=U HDR^DENTAR16 Q

NONE S DENTF1=1 W !,"There is no treatment data for review/release for the time frame you specified",*7 G EXIT1

EXIT 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)

 D:'$D(DENTF1) COMP^DENTAR16 W ! D:$D(DENTF1)&(Z5'=U) HOLD

EXIT1 X ^%ZIS("C") K DENT,DENTCAT,DENTDAT,DENTED,DENTF,DENTSD,H,H1,H2,H3,I,J,K,X D:$D(ZTSK) EXIT1^DENTAR1 Q

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DENTAR14   3695     printed  Feb 18, 2025@23:12:20                                                                                                                                                                                                    Page 2

DENTAR14  ;ISC2/SAW,HAG-REVIEW/RELEASE TREATMENT DATA REPORT - INDIVIDUAL SITTINGS ; 10/27/88  10:15 AM ;

 +1       ;VERSION 1.2

 +2        SET %ZIS="MQ"

           KILL IO("Q")

           DO ^%ZIS

           if IO=""

               GOTO EXIT1

 +3        IF $DATA(IO("Q"))

               SET ZTRTN="QUE^DENTAR14"

               SET ZTSAVE("DENT*")=""

               SET ZTSAVE("DT")=""

               SET ZTSAVE("U")=""

               SET ZTSAVE("Z3")=""

               SET ZTSAVE("Z5")=""

               SET ZTSAVE("H*")=""

               DO ^%ZTLOAD

               KILL ZTSK,ZTRTN,ZTSAVE

               GOTO EXIT1

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

           if Z5'=U

               DO HOLD

           if Z5=U

               SET DENTF1=1

           GOTO EXIT

RPT        FOR I=0:1

               SET DENTSD=$ORDER(^DENT(221,"A",Z3,DENTSD))

               if DENTSD>DENTED!(DENTSD="")!(DT<DT1&($EXTRACT(DENTSD,1,5)=$EXTRACT(DT,1,5)))

                   QUIT 

               DO RPT1

 +1        QUIT 

RPT1       if 'I

               DO HDR^DENTAR16

           SET DENT=""

           FOR J=0:0

               SET DENT=$ORDER(^DENT(221,"A",Z3,DENTSD,DENT))

               if DENT=""

                   QUIT 

               IF $DATA(^DENT(221,DENT,0))

                   SET X=^(0)

                   DO HDR1

                   if Z5=U

                       QUIT 

                   DO P1

                   if Z5=U

                       QUIT 

 +1        QUIT 

P1         IF $DATA(^DENT(221,DENT,.1))

               IF $PIECE(^(.1),U,1)

                   QUIT 

 +1        SET DENTC=DENTC+1

           DO CHK^DENTAR15

           if DENTF

               QUIT 

           if '$DATA(DENTF1)

               SET ^UTILITY($JOB,"DENTP",DENT)=DENTSD

 +2        IF '$DATA(DENTF1)

               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

 +3        SET DENTCAT=$PIECE(X,U,19)

           SET DENTCAT="00"_DENTCAT

           SET DENTCAT=$EXTRACT(DENTCAT,$LENGTH(DENTCAT)-1,$LENGTH(DENTCAT))

 +4        IF IO=IO(0)

               IF '$DATA(DENTF1)

                   IF '$DATA(DENTV)

                       DO DENTV

 +5        IF $PIECE(X,U,27)

               SET K=$SELECT($PIECE(X,U,27)=1:35,1:37)

               WRITE ?46,$EXTRACT($PIECE(^DIC(220.3,K,0),U,1),1,30),?79,1,!

               if IOSL-($Y#IOSL)<4

                   DO HOLD1

               if Z5=U

                   QUIT 

               SET X(1)=$PIECE(X,U,27)

               DO SPOT

               QUIT 

 +6        IF $PIECE(X,U,44)

               WRITE ?46,$EXTRACT($PIECE(^DIC(220.3,36,0),U,1),1,30),?79,1,!

               if $PIECE(X,U,45)

                   WRITE ?46,$EXTRACT($PIECE(^DIC(220.3,38,0),U,1),1,30),?79,$PIECE(X,U,45),!

               if IOSL-($Y#IOSL)<4

                   DO HOLD1

               if Z5=U

                   QUIT 

               SET X(1)=$PIECE(X,U,44)

               DO SPOT

               QUIT 

 +7        IF $PIECE(X,U,41)

               WRITE ?46,$EXTRACT($PIECE(^DIC(220.3,$PIECE(X,U,41),0),U,1),1,30),?79,1,!

               if IOSL-($Y#IOSL)<4

                   DO HOLD1

               if Z5=U

                   QUIT 

               SET X(2)=0_$PIECE(X,U,41)

               IF IO=IO(0)

                   IF '$DATA(DENTF1)

                       SET DENTV=DENTV_X(2)_"01"

 +8        IF $PIECE(X,U,8)

               WRITE ?46,"ADMINISTRATIVE PROCEDURE",?79,1,!

               if IOSL-($Y#IOSL)<4

                   DO HOLD1

               if Z5=U

                   QUIT 

               IF IO=IO(0)

                   IF '$DATA(DENTF1)

                       SET DENTV=DENTV_3501

 +9        IF $PIECE(X,U,7)'=""

               SET X(2)=$SELECT($PIECE(X,U,7)="S":"04",1:"05")

               WRITE ?46,$EXTRACT($PIECE(^DIC(220.3,+X(2),0),U,1),1,30),?79,1,!

               if IOSL-($Y#IOSL)<4

                   DO HOLD1

               if Z5=U

                   QUIT 

               IF IO=IO(0)

                   IF '$DATA(DENTF1)

                       SET DENTV=DENTV_X(2)_"01"

 +10       FOR K=9,11:1:18,20,22:1:26,28:1:38,42:1:43

               IF $PIECE(X,U,K)

                   DO W

                   if Z5=U

                       QUIT 

 +11       IF IO=IO(0)

               IF '$DATA(DENTF1)

                   SET $PIECE(X1," ",51)=" "

                   SET DENTV=DENTV_X1

                   SET ^UTILITY($JOB,"DENTV",Q,DENTC,0)=$EXTRACT(DENTV,1,80)

                   KILL X1,DENTV

 +12       QUIT 

W          WRITE ?46,$EXTRACT($PIECE(^DIC(220.3,+$PIECE($TEXT(S),";",K),0),U,1),1,30),?77,$JUSTIFY($PIECE(X,U,K),3),!

           if IOSL-($Y#IOSL)<4

               DO HOLD1

           if Z5=U

               QUIT 

 +1        IF IO=IO(0)

               IF '$DATA(DENTF1)

                   SET X(2)=$PIECE($TEXT(S),";",K)

                   SET X(3)=$PIECE(X,U,K)

                   SET X(3)=0_X(3)

                   SET X(3)=$EXTRACT(X(3),($LENGTH(X(3))-1),$LENGTH(X(3)))

                   SET DENTV=DENTV_X(2)_X(3)

 +2        QUIT 

SPOT       IF IO=IO(0)

               IF '$DATA(DENTF1)

                   SET DENTDAT=$PIECE(X,U,1)

                   SET DENTDAT=$EXTRACT(DENTDAT,4,5)_$EXTRACT(DENTDAT,6,7)_$EXTRACT(DENTDAT,2,3)

 +1        QUIT 

HDR1       IF IOSL-($Y#IOSL)<4

               DO HOLD

               if Z5=U

                   QUIT 

               DO HDR^DENTAR16

 +1        SET Y=$PIECE(X,U,1)

           XECUTE ^DD("DD")

           WRITE !,Y,?19,$PIECE(X,U,10),?25,$PIECE(X,U,2),?36,$JUSTIFY($PIECE(X,U,19),2),?41

           if $PIECE(X,U,19)<9

               WRITE $JUSTIFY($PIECE(X,U,6),2)

           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 DENTV=1_DENTSTA_$PIECE(X,U,10)_$EXTRACT($PIECE(X,U,2),1,9)_DENTCAT_X(1)_DENTDAT

           QUIT 

HOLD       if $DATA(ZTSK)!(IO'=IO(0))!(Z5=U)

               QUIT 

           SET Z5=""

           READ !,"Press return to continue, uparrow (^) to exit: ",Z5:DTIME

           QUIT 

HOLD1      DO HOLD

           if Z5'=U

               DO HDR^DENTAR16

           QUIT 

NONE       SET DENTF1=1

           WRITE !,"There is no treatment data for review/release for the time frame you specified",*7

           GOTO EXIT1

EXIT       if Z5=U

               GOTO EXIT1

           IF $DATA(DENTF1)

               WRITE @IOF,*7

               DO ERR^DENTAR16

               SET H=""

               FOR I=1:1

                   if Z5=U

                       QUIT 

                   SET H=$ORDER(^UTILITY($JOB,"DENTERR",H))

                   if H=""

                       QUIT 

                   FOR J=1:1:5

                       if IOSL-($Y#IOSL)<4

                           DO HOLD

                       if Z5=U

                           QUIT 

                       if $DATA(^UTILITY($JOB,"DENTERR",H,J))

                           WRITE !,^(J)

 +1        if '$DATA(DENTF1)

               DO COMP^DENTAR16

           WRITE !

           if $DATA(DENTF1)&(Z5'=U)

               DO HOLD

EXIT1      XECUTE ^%ZIS("C")

           KILL DENT,DENTCAT,DENTDAT,DENTED,DENTF,DENTSD,H,H1,H2,H3,I,J,K,X

           if $DATA(ZTSK)

               DO EXIT1^DENTAR1

           QUIT 

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