- DENTA13 ;ISC2/SAW,HAG-TREATMENT DATA SUMMARY REPORT FOR CLINIC ; 4/3/89 4:11 PM ;
- ;VERSION 1.2
- A S (DENT3,DENT4)="" W !!,"Do you wish to print the optional 3rd page of the summary" S %=2 D YN^DICN D:%=0 Q5^DENTQ G A:%=0,EXIT:%<0,A2:%=2
- A1 S DENT3=1 W !!,"Do you wish to see the $VALUE on this 3rd page" S %=2 D YN^DICN D:%=0 Q6^DENTQ G A1:%=0,EXIT:%<0 S:%=1 DENT4=1
- A2 S DENTC=0,DENTSD=DENTSD-.0001,%ZIS="MQ" K IO("Q") D ^%ZIS G EXIT:IO=""
- I $D(IO("Q")) S ZTRTN="QUE^DENTA13",ZTSAVE("DENT*")="",ZTSAVE("H1")="",ZTSAVE("H2")="",ZTSAVE("U")="",ZTSAVE("Z5")="" D ^%ZTLOAD K ZTSK,ZTRTN,ZTSAVE G EXIT
- QUE U IO D RPT G NONE:'DENTC D A^DENTA15 G CLOSE
- RPT F I=0:0 S DENTSD=$O(^DENT(221,"A1",DENTSTA,DENTSD)) Q:DENTSD>DENTED!(DENTSD="") S DENT="" F K=0:0 S DENT=$O(^DENT(221,"A1",DENTSTA,DENTSD,DENT)) Q:DENT="" D:$D(^DENT(221,DENT,0)) P1
- 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)
- I $P(X,U,27)'=""!($P(X,U,44)'="") D SPOT Q
- P1A D CHK^DENTA15 Q:DENTF S DENTCAT=$P(X,U,19)
- I $P(X,U,9)!($P(X,U,11)) S ^UTILITY($J,"DENTR",7,DENTCAT)=$S($D(^UTILITY($J,"DENTR",7,DENTCAT)):^(DENTCAT)+1,1:1)
- I $P(X,U,41) S X(2)=$P(X,U,41),^UTILITY($J,"DENTR",X(2),DENTCAT)=$S($D(^UTILITY($J,"DENTR",X(2),DENTCAT)):^(DENTCAT)+1,1:1)
- I $P(X,U,8) S ^UTILITY($J,"DENTR",39,DENTCAT)=$S($D(^UTILITY($J,"DENTR",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",X(2),DENTCAT)=$S($D(^UTILITY($J,"DENTR",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",+X(2),DENTCAT),U,1)=$S($D(^UTILITY($J,"DENTR",+X(2),DENTCAT)):$P(^(DENTCAT),U,1)+X(3),1:+X(3))
- I M=36 S $P(^UTILITY($J,"DENTR",+X(2),DENTCAT),"^",2)=$S($D(^UTILITY($J,"DENTR",+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",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))
- 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
- CLOSE X ^%ZIS("C")
- EXIT K DENT,DENTCAT,DENTCAT1,DENTDAT,DENTED,DENTSD,DENT3,DENT4,H,I,K,M,V,V1,X D:$D(ZTSK) EXIT1^DENTA1 Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDENTA13 2680 printed Feb 18, 2025@23:12:07 Page 2
- DENTA13 ;ISC2/SAW,HAG-TREATMENT DATA SUMMARY REPORT FOR CLINIC ; 4/3/89 4:11 PM ;
- +1 ;VERSION 1.2
- A SET (DENT3,DENT4)=""
- 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 A
- if %<0
- GOTO EXIT
- if %=2
- GOTO A2
- A1 SET DENT3=1
- 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 A1
- if %<0
- GOTO EXIT
- if %=1
- SET DENT4=1
- A2 SET DENTC=0
- SET DENTSD=DENTSD-.0001
- SET %ZIS="MQ"
- KILL IO("Q")
- DO ^%ZIS
- if IO=""
- GOTO EXIT
- +1 IF $DATA(IO("Q"))
- SET ZTRTN="QUE^DENTA13"
- SET ZTSAVE("DENT*")=""
- SET ZTSAVE("H1")=""
- SET ZTSAVE("H2")=""
- SET ZTSAVE("U")=""
- SET ZTSAVE("Z5")=""
- DO ^%ZTLOAD
- KILL ZTSK,ZTRTN,ZTSAVE
- GOTO EXIT
- QUE USE IO
- DO RPT
- if 'DENTC
- GOTO NONE
- DO A^DENTA15
- GOTO CLOSE
- RPT FOR I=0:0
- SET DENTSD=$ORDER(^DENT(221,"A1",DENTSTA,DENTSD))
- if DENTSD>DENTED!(DENTSD="")
- QUIT
- SET DENT=""
- FOR K=0:0
- SET DENT=$ORDER(^DENT(221,"A1",DENTSTA,DENTSD,DENT))
- if DENT=""
- QUIT
- if $DATA(^DENT(221,DENT,0))
- DO P1
- +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)
- +2 IF $PIECE(X,U,27)'=""!($PIECE(X,U,44)'="")
- DO SPOT
- QUIT
- P1A DO CHK^DENTA15
- if DENTF
- QUIT
- SET DENTCAT=$PIECE(X,U,19)
- +1 IF $PIECE(X,U,9)!($PIECE(X,U,11))
- SET ^UTILITY($JOB,"DENTR",7,DENTCAT)=$SELECT($DATA(^UTILITY($JOB,"DENTR",7,DENTCAT)):^(DENTCAT)+1,1:1)
- +2 IF $PIECE(X,U,41)
- SET X(2)=$PIECE(X,U,41)
- SET ^UTILITY($JOB,"DENTR",X(2),DENTCAT)=$SELECT($DATA(^UTILITY($JOB,"DENTR",X(2),DENTCAT)):^(DENTCAT)+1,1:1)
- +3 IF $PIECE(X,U,8)
- SET ^UTILITY($JOB,"DENTR",39,DENTCAT)=$SELECT($DATA(^UTILITY($JOB,"DENTR",39,DENTCAT)):^(DENTCAT)+1,1:1)
- +4 IF $PIECE(X,U,7)'=""
- SET X(2)=$SELECT($PIECE(X,U,7)="S":"4",1:"5")
- SET ^UTILITY($JOB,"DENTR",X(2),DENTCAT)=$SELECT($DATA(^UTILITY($JOB,"DENTR",X(2),DENTCAT)):^(DENTCAT)+1,1:1)
- +5 FOR M=9,11:1:18,20,22:1:26,28:1:38,42:1:43
- IF $PIECE(X,U,M)
- DO P11
- +6 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",+X(2),DENTCAT),U,1)=$SELECT($DATA(^UTILITY($JOB,"DENTR",+X(2),DENTCAT)):$PIECE(^(DENTCAT),U,1)+X(3),1:+X(3))
- +1 IF M=36
- SET $PIECE(^UTILITY($JOB,"DENTR",+X(2),DENTCAT),"^",2)=$SELECT($DATA(^UTILITY($JOB,"DENTR",+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",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 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
- CLOSE XECUTE ^%ZIS("C")
- EXIT KILL DENT,DENTCAT,DENTCAT1,DENTDAT,DENTED,DENTSD,DENT3,DENT4,H,I,K,M,V,V1,X
- if $DATA(ZTSK)
- DO EXIT1^DENTA1
- QUIT