- DENTAR11 ;ISC2/SAW,HAG-REVIEW/RELEASE TREATMENT DATA SUMMARY REPORT BY PROVIDER ; 12/2/88 6:53 PM ;
- ;VERSION 1.2
- A W !!,"Would you like to review the data for all providers" S %=1 D YN^DICN D:%=0 Q G A:%=0,EXIT:%<0
- 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)
- S %ZIS="MQ" K IO("Q") D ^%ZIS G EXIT:IO=""
- I $D(IO("Q")) S ZTRTN="QUE^DENTAR11",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
- QUE U IO S Q=1,DENTPRV1=$S($D(DENTPRV):DENTPRV,1:""),DENTPRV=$S($D(DENTPRV):DENTPRV-1,1:""),(DENTC(1),DENTC)=0,DENTSD=DENTSD-.0001
- S:$L(DENTPRV)<4&(DENTPRV]"") DENTPRV=$E("000"_DENTPRV,$L(DENTPRV),$L(DENTPRV)+3) S DENTPRV2=DENTPRV,DT1=$E(DT,1,5)_"08"
- 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
- D ^DENTAR15 G EXIT
- 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
- Q
- P1 I $D(^DENT(221,DENT,.1)),$P(^(.1),U,1) Q
- 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
- I $P(X,U,27)'=""!($P(X,U,44)'="") D SPOT Q
- D CHK^DENTAR15 Q:DENTF S DENTCAT=$P(X,U,19)
- I IO=IO(0),'$D(DENTF1),'$D(DENTV) D DENTV^DENTAR13
- I $P(X,U,41) S X(2)=0_$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 IO=IO(0),'$D(DENTF1) S DENTV=DENTV_X(2)_"01"
- 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 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",DENTPRV,+X(2),DENTCAT)=$S($D(^UTILITY($J,"DENTR",DENTPRV,+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",DENTPRV,+X(2),DENTCAT)=$S($D(^UTILITY($J,"DENTR",DENTPRV,+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",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))
- 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)_$P(X,U,2)_"0000"_DENTDAT_DENTCAT_X(1)_$S(X(1)=2:" ",$P(X,U,45)="":0,1:$P(X,U,45))_" "
- 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
- Q W !!,"Press return if you want to include all providers in this report.",!,"Enter an 'N' for 'No' and you will be prompted to select just one provider.",!,"Enter an uparrow (^) to exit this option altogether." Q
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDENTAR11 3935 printed Feb 18, 2025@23:12:17 Page 2
- DENTAR11 ;ISC2/SAW,HAG-REVIEW/RELEASE TREATMENT DATA SUMMARY REPORT BY PROVIDER ; 12/2/88 6:53 PM ;
- +1 ;VERSION 1.2
- A WRITE !!,"Would you like to review the data for all providers"
- SET %=1
- DO YN^DICN
- if %=0
- DO Q
- if %=0
- GOTO A
- if %<0
- GOTO EXIT
- +1 IF %=2
- SET DIC="^DENT(220.5,"
- SET DIC(0)="AEQMZ"
- DO ^DIC
- if Y<0
- GOTO EXIT
- KILL DIC
- SET DENTPRV=$PIECE(Y(0),U,2)
- +2 SET %ZIS="MQ"
- KILL IO("Q")
- DO ^%ZIS
- if IO=""
- GOTO EXIT
- +3 IF $DATA(IO("Q"))
- SET ZTRTN="QUE^DENTAR11"
- 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,ZTSAVE
- GOTO EXIT
- QUE USE IO
- SET Q=1
- SET DENTPRV1=$SELECT($DATA(DENTPRV):DENTPRV,1:"")
- SET DENTPRV=$SELECT($DATA(DENTPRV):DENTPRV-1,1:"")
- SET (DENTC(1),DENTC)=0
- SET DENTSD=DENTSD-.0001
- +1 if $LENGTH(DENTPRV)<4&(DENTPRV]"")
- SET DENTPRV=$EXTRACT("000"_DENTPRV,$LENGTH(DENTPRV),$LENGTH(DENTPRV)+3)
- SET DENTPRV2=DENTPRV
- SET DT1=$EXTRACT(DT,1,5)_"08"
- +2 FOR I=0:0
- SET DENTSD=$ORDER(^DENT(221,"AC",Z3,DENTSD))
- if DENTSD>DENTED!(DENTSD="")!(DT<DT1&($EXTRACT(DENTSD,1,5)=$EXTRACT(DT,1,5)))
- QUIT
- SET DENTPRV=DENTPRV2
- FOR J=0:0
- SET DENTPRV=$ORDER(^DENT(221,"AC",Z3,DENTSD,DENTPRV))
- if $SELECT(DENTPRV1=""
- QUIT
- DO RPT
- +3 DO ^DENTAR15
- GOTO EXIT
- RPT SET DENT=""
- FOR K=0:0
- SET DENT=$ORDER(^DENT(221,"AC",Z3,DENTSD,DENTPRV,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)
- SET DENTF=0
- IF '$DATA(DENTF1)
- SET ^UTILITY($JOB,"DENTP",DENT)=DENTSD_","_DENTPRV
- 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
- +3 DO CHK^DENTAR15
- if DENTF
- QUIT
- SET DENTCAT=$PIECE(X,U,19)
- +4 IF IO=IO(0)
- IF '$DATA(DENTF1)
- IF '$DATA(DENTV)
- DO DENTV^DENTAR13
- +5 IF $PIECE(X,U,41)
- SET X(2)=0_$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)
- IF IO=IO(0)
- IF '$DATA(DENTF1)
- SET DENTV=DENTV_X(2)_"01"
- +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)
- IF IO=IO(0)
- IF '$DATA(DENTF1)
- SET DENTV=DENTV_3501
- +7 IF $PIECE(X,U,7)'=""
- SET X(2)=$SELECT($PIECE(X,U,7)="S":"04",1:"05")
- SET ^UTILITY($JOB,"DENTR",DENTPRV,+X(2),DENTCAT)=$SELECT($DATA(^UTILITY($JOB,"DENTR",DENTPRV,+X(2),DENTCAT)):^(DENTCAT)+1,1:1)
- +8 IF $PIECE(X,U,7)'=""
- IF IO=IO(0)
- IF '$DATA(DENTF1)
- SET DENTV=DENTV_X(2)_"01"
- +9 FOR M=9,11:1:18,20,22:1:26,28:1:38,42:1:43
- IF $PIECE(X,U,M)
- DO P11
- +10 IF IO=IO(0)
- IF '$DATA(DENTF1)
- SET DENTV=DENTV_" "
- SET ^UTILITY($JOB,"DENTV",Q,DENTC,0)=$EXTRACT(DENTV,1,80)
- KILL DENTV
- +11 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",DENTPRV,+X(2),DENTCAT)=$SELECT($DATA(^UTILITY($JOB,"DENTR",DENTPRV,+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",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 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)_$PIECE(X,U,2)_"0000"_DENTDAT_DENTCAT_X(1)_$SELECT(X(1)=2:" ",$PIECE(X,U,45)="":0,1:$PIECE(X,U,45))_"
- "
- +6 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
- Q WRITE !!,"Press return if you want to include all providers in this report.",!,"Enter an 'N' for 'No' and you will be prompted to select just one provider.",!,"Enter an uparrow (^) to exit this option altogether."
- QUIT
- EXIT XECUTE ^%ZIS("C")
- KILL %,DENT,DENTCAT,DENTCAT1,DENTDAT,DENTED,DENTF,DENTPRV,DENTPRV1,DENTPRV2,DENTSD,DIC,I,J,K,M,X,Y
- if $DATA(ZTSK)
- DO EXIT1^DENTAR1
- QUIT