- DENTAR1 ;ISC2/SAW,HAG-RELEASE DENTAL TREATMENT DATA SERVICE REPORTS FOR TRANSMISSION TO AUSTIN ;1/26/98 13:54 ;
- ;;1.2;DENTAL;**2,24**;JAN 26, 1989
- D:'$D(DT) DT^DICRW S %O="OPT",U="^",S=";",O=$T(@(%O)),DENTV=$$VERSION^XPDUTL("DENT") I $D(^DOPT($P(O,S,5),"VERSION")),(DENTV=^DOPT($P(O,S,5),"VERSION")) G IN
- K ^DOPT($P(O,S,5))
- F I=1:1 Q:$T(@(%O)+I)="" S ^DOPT($P(O,S,5),I,0)=$P($T(@(%O)+I),S,3),^DOPT($P(O,S,5),"B",$P($P($T(@(%O)+I),S,3),"^",1),I)=""
- S K=I-1,^DOPT($P(O,S,5),0)=$P(O,S,4)_U_1_U_K_U_K K I,K,X S ^DOPT($P(O,S,5),"VERSION")=DENTV
- IN I $P(O,S,6)'="" D @($P(O,S,6))
- PR S O=$T(@(%O)),S=";" S IOP=$I D ^%ZIS W:IOST'["PK-" @IOF K IOP
- I $P(O,S,7)'="" D @($P(O,S,7))
- E W !!,$P(O,S,3),":",!,$$VERSION^XPDUTL("DENT")," ",$P($T(+1),S,1),!!,$P(O,S,4),"S:",!
- F J=1:1 Q:'$D(^DOPT($P(O,S,5),J,0)) S K=$S(J<10:15,1:14) W !,?K,J,". ",$P(^DOPT($P(O,S,5),J,0),U,1)
- RE W ! S DIC("A")="Select "_$P($T(OPT),S,4)_": EXIT// ",DIC="^DOPT("_""""_$P($T(OPT),S,5)_""""_",",DIC(0)="AEQMN" D ^DIC G:X=""!(X=U) EXIT G:Y<0 RE K DIC,J,O D @($P($T(OPT+Y),S,4)) G PR
- PROV D DATE G EXIT:Y<0 D ^DENTAR11 G ASK
- SITPROV D DATE G EXIT:Y<0 D ^DENTAR12 G ASK
- CLINIC D DATE G EXIT:Y<0 D ^DENTAR13 G ASK
- SIT D DATE G EXIT:Y<0 D ^DENTAR14 G ASK
- NOREV D DATE G EXIT:Y<0 D NOREV^DENTAR16 G ASK
- DATE W !! K ^UTILITY($J,"DENTERR"),^UTILITY($J,"DENTV"),^UTILITY($J,"DENTR"),^UTILITY($J,"DENTP") S U="^",Z5="",Z1=0 G W:'$D(^DENT(225,0)) F Z3=0:1:2 S Z1=$O(^(Z1)) Q:Z1'>0 S Z2=Z1
- G:Z3=0 W I Z3>1 S DIC="^DENT(225,",DIC(0)="AEMNQZ",DIC("A")="Select STATION.DIVISION: " S:$D(DENTSTA) DIC("B")=$S(DENTSTA[" ":+DENTSTA,1:DENTSTA) D ^DIC Q:Y<0 K DIC("A"),DIC("B")
- S Z1=$S(Z3=1:Z2,1:+Y) S (DENTSTA,Z3)=$P(^DENT(225,Z1,0),U,1) I DENTSTA="" D W S Y=-1 Q
- S:$L(DENTSTA)=3 DENTSTA=DENTSTA_" "
- D1 W !!,"Enter the starting and ending dates for the Treatment Data entries that",!,"you wish to review/release",!
- S %DT("A")="STARTING DATE: ",%DT="AEPX" D ^%DT K %DT("A") Q:Y<0 S DENTSD=Y X ^DD("DD") S H1=Y
- S %DT("A")="ENDING DATE: ",%DT="AEPX" D ^%DT K %DT("A") Q:Y<0 S DENTED=Y+.24 X ^DD("DD") S H2=Y
- I DENTED<DENTSD W *7,!!,"End Date before Start Date?" G D1
- Q
- ASK I '$D(DENTC)!($D(ZTSK))!($D(DENTF1)) G CLOSE
- G CLOSE:'DENTC!(IO'=IO(0)) U IO(0) I IO=IO(0)
- A W !!,"Okay to release this report for transmission to Austin" S %=2 D YN^DICN D:%=0 Q4^DENTQ G A:%=0 I %'=1 W !,"Nothing released",*7 G CLOSE
- EN1 S ^UTILITY($J,"DENTV",Q,DENTC,0)=^UTILITY($J,"DENTV",Q,DENTC,0)_"$"
- S DENTA=$S($E(DENTSTA,4,5)=" ":+DENTSTA,1:DENTSTA),DENTA=$O(^DENT(225,"B",DENTA,0)) I DENTA S DENTA=$S($D(^DENT(225,DENTA,0)):$P(^(0),"^",3),1:"")
- I DENTA="Y" F Q1=1:1:Q S XMDUZ=DUZ,XMY(DUZ)="",XMY("XXX@Q-DAS.DOMAIN.EXT")="",XMSUB="DENTAL SERVICE TREATMENT DATA, "_$P(H5,":",1)_": "_Z3_" ( MESSAGE NO.: "_Q1_")",XMTEXT="^UTILITY("_$J_",""DENTV"","_Q1_"," D ^XMD
- G M:DENTA="Y" S K=0,Q1=$S($D(^UTILITY("DENTV")):^("DENTV"),1:0) F I=1:1:Q S N="" F J=0:0 S N=$O(^UTILITY($J,"DENTV",I,N)) Q:N="" S K=K+1,%X="^UTILITY("_$J_",""DENTV"","_I_","_N_",",%Y="^UTILITY(""DENTV"","_(Q1+K)_"," D %XY^%RCR
- S ^UTILITY("DENTV")=Q1+K
- M F X=0:0 S X=$O(^UTILITY($J,"DENTP",X)) Q:X="" S X1=^(X),^DENT(221,X,.1)=DUZ_"^"_DT,^DENT(221,"AG",Z3,DT,X)="" K:X1["," ^DENT(221,"AC",Z3,X1,X),^DENT(221,"A",Z3,$P(X1,",",1),X) K:X1'["," ^DENT(221,"AC",Z3,X1),^DENT(221,"A",Z3,X1)
- W !,"Report released for transmission to Austin"
- G CLOSE
- W W !!,"Stations have not been entered in the Dental Site Parameter file.",!,"You must enter a station before you can use this option" Q
- CLOSE X ^%ZIS("C")
- EXIT K %,%DT,%X,%Y,A,DENTA,DENTC,DENTED,DENTF,DENTF1,DENTSD,DENTV,DIC,H1,H2,H5,I,J,K,N,O,Q,Q1,S,X,X1,XMDUZ,XMSUB,XMTEXT,XMY,Y,Z1,Z2,Z3,Z5
- EXIT1 K ^UTILITY($J,"DENTERR"),^UTILITY($J,"DENTV"),^UTILITY($J,"DENTR"),^UTILITY($J,"DENTP") K:$D(ZTSK) ^%ZTSK(ZTSK) Q
- OPT ;;REVIEW TREATMENT DATA SERVICE REPORTS;OPTION;DENTAR1
- ;;PROVIDER SUMMARY;PROV
- ;;SITTINGS BY PROVIDER;SITPROV
- ;;CLINIC SUMMARY;CLINIC
- ;;INDIVIDUAL SITTINGS;SIT
- ;;NO REVIEW;NOREV
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDENTAR1 4003 printed Feb 18, 2025@23:12:16 Page 2
- DENTAR1 ;ISC2/SAW,HAG-RELEASE DENTAL TREATMENT DATA SERVICE REPORTS FOR TRANSMISSION TO AUSTIN ;1/26/98 13:54 ;
- +1 ;;1.2;DENTAL;**2,24**;JAN 26, 1989
- +2 if '$DATA(DT)
- DO DT^DICRW
- SET %O="OPT"
- SET U="^"
- SET S=";"
- SET O=$TEXT(@(%O))
- SET DENTV=$$VERSION^XPDUTL("DENT")
- IF $DATA(^DOPT($PIECE(O,S,5),"VERSION"))
- IF (DENTV=^DOPT($PIECE(O,S,5),"VERSION"))
- GOTO IN
- +3 KILL ^DOPT($PIECE(O,S,5))
- +4 FOR I=1:1
- if $TEXT(@(%O)+I)=""
- QUIT
- SET ^DOPT($PIECE(O,S,5),I,0)=$PIECE($TEXT(@(%O)+I),S,3)
- SET ^DOPT($PIECE(O,S,5),"B",$PIECE($PIECE($TEXT(@(%O)+I),S,3),"^",1),I)=""
- +5 SET K=I-1
- SET ^DOPT($PIECE(O,S,5),0)=$PIECE(O,S,4)_U_1_U_K_U_K
- KILL I,K,X
- SET ^DOPT($PIECE(O,S,5),"VERSION")=DENTV
- IN IF $PIECE(O,S,6)'=""
- DO @($PIECE(O,S,6))
- PR SET O=$TEXT(@(%O))
- SET S=";"
- SET IOP=$IO
- DO ^%ZIS
- if IOST'["PK-"
- WRITE @IOF
- KILL IOP
- +1 IF $PIECE(O,S,7)'=""
- DO @($PIECE(O,S,7))
- +2 IF '$TEST
- WRITE !!,$PIECE(O,S,3),":",!,$$VERSION^XPDUTL("DENT")," ",$PIECE($TEXT(+1),S,1),!!,$PIECE(O,S,4),"S:",!
- +3 FOR J=1:1
- if '$DATA(^DOPT($PIECE(O,S,5),J,0))
- QUIT
- SET K=$SELECT(J<10:15,1:14)
- WRITE !,?K,J,". ",$PIECE(^DOPT($PIECE(O,S,5),J,0),U,1)
- RE WRITE !
- SET DIC("A")="Select "_$PIECE($TEXT(OPT),S,4)_": EXIT// "
- SET DIC="^DOPT("_""""_$PIECE($TEXT(OPT),S,5)_""""_","
- SET DIC(0)="AEQMN"
- DO ^DIC
- if X=""!(X=U)
- GOTO EXIT
- if Y<0
- GOTO RE
- KILL DIC,J,O
- DO @($PIECE($TEXT(OPT+Y),S,4))
- GOTO PR
- PROV DO DATE
- if Y<0
- GOTO EXIT
- DO ^DENTAR11
- GOTO ASK
- SITPROV DO DATE
- if Y<0
- GOTO EXIT
- DO ^DENTAR12
- GOTO ASK
- CLINIC DO DATE
- if Y<0
- GOTO EXIT
- DO ^DENTAR13
- GOTO ASK
- SIT DO DATE
- if Y<0
- GOTO EXIT
- DO ^DENTAR14
- GOTO ASK
- NOREV DO DATE
- if Y<0
- GOTO EXIT
- DO NOREV^DENTAR16
- GOTO ASK
- DATE WRITE !!
- KILL ^UTILITY($JOB,"DENTERR"),^UTILITY($JOB,"DENTV"),^UTILITY($JOB,"DENTR"),^UTILITY($JOB,"DENTP")
- SET U="^"
- SET Z5=""
- SET Z1=0
- if '$DATA(^DENT(225,0))
- GOTO W
- FOR Z3=0:1:2
- SET Z1=$ORDER(^(Z1))
- if Z1'>0
- QUIT
- SET Z2=Z1
- +1 if Z3=0
- GOTO W
- IF Z3>1
- SET DIC="^DENT(225,"
- SET DIC(0)="AEMNQZ"
- SET DIC("A")="Select STATION.DIVISION: "
- if $DATA(DENTSTA)
- SET DIC("B")=$SELECT(DENTSTA[" ":+DENTSTA,1:DENTSTA)
- DO ^DIC
- if Y<0
- QUIT
- KILL DIC("A"),DIC("B")
- +2 SET Z1=$SELECT(Z3=1:Z2,1:+Y)
- SET (DENTSTA,Z3)=$PIECE(^DENT(225,Z1,0),U,1)
- IF DENTSTA=""
- DO W
- SET Y=-1
- QUIT
- +3 if $LENGTH(DENTSTA)=3
- SET DENTSTA=DENTSTA_" "
- D1 WRITE !!,"Enter the starting and ending dates for the Treatment Data entries that",!,"you wish to review/release",!
- +1 SET %DT("A")="STARTING DATE: "
- SET %DT="AEPX"
- DO ^%DT
- KILL %DT("A")
- if Y<0
- QUIT
- SET DENTSD=Y
- XECUTE ^DD("DD")
- SET H1=Y
- +2 SET %DT("A")="ENDING DATE: "
- SET %DT="AEPX"
- DO ^%DT
- KILL %DT("A")
- if Y<0
- QUIT
- SET DENTED=Y+.24
- XECUTE ^DD("DD")
- SET H2=Y
- +3 IF DENTED<DENTSD
- WRITE *7,!!,"End Date before Start Date?"
- GOTO D1
- +4 QUIT
- ASK IF '$DATA(DENTC)!($DATA(ZTSK))!($DATA(DENTF1))
- GOTO CLOSE
- +1 if 'DENTC!(IO'=IO(0))
- GOTO CLOSE
- USE IO(0)
- IF IO=IO(0)
- A WRITE !!,"Okay to release this report for transmission to Austin"
- SET %=2
- DO YN^DICN
- if %=0
- DO Q4^DENTQ
- if %=0
- GOTO A
- IF %'=1
- WRITE !,"Nothing released",*7
- GOTO CLOSE
- EN1 SET ^UTILITY($JOB,"DENTV",Q,DENTC,0)=^UTILITY($JOB,"DENTV",Q,DENTC,0)_"$"
- +1 SET DENTA=$SELECT($EXTRACT(DENTSTA,4,5)=" ":+DENTSTA,1:DENTSTA)
- SET DENTA=$ORDER(^DENT(225,"B",DENTA,0))
- IF DENTA
- SET DENTA=$SELECT($DATA(^DENT(225,DENTA,0)):$PIECE(^(0),"^",3),1:"")
- +2 IF DENTA="Y"
- FOR Q1=1:1:Q
- SET XMDUZ=DUZ
- SET XMY(DUZ)=""
- SET XMY("XXX@Q-DAS.DOMAIN.EXT")=""
- SET XMSUB="DENTAL SERVICE TREATMENT DATA, "_$PIECE(H5,":",1)_": "_Z3_" ( MESSAGE NO.: "_Q1_")"
- SET XMTEXT="^UTILITY("_$JOB_",""DENTV"","_Q1_","
- DO ^XMD
- +3 if DENTA="Y"
- GOTO M
- SET K=0
- SET Q1=$SELECT($DATA(^UTILITY("DENTV")):^("DENTV"),1:0)
- FOR I=1:1:Q
- SET N=""
- FOR J=0:0
- SET N=$ORDER(^UTILITY($JOB,"DENTV",I,N))
- if N=""
- QUIT
- SET K=K+1
- SET %X="^UTILITY("_$JOB_",""DENTV"","_I_","_N_","
- SET %Y="^UTILITY(""DENTV"","_(Q1+K)_","
- DO %XY^%RCR
- +4 SET ^UTILITY("DENTV")=Q1+K
- M FOR X=0:0
- SET X=$ORDER(^UTILITY($JOB,"DENTP",X))
- if X=""
- QUIT
- SET X1=^(X)
- SET ^DENT(221,X,.1)=DUZ_"^"_DT
- SET ^DENT(221,"AG",Z3,DT,X)=""
- if X1[","
- KILL ^DENT(221,"AC",Z3,X1,X),^DENT(221,"A",Z3,$PIECE(X1,",",1),X)
- if X1'[","
- KILL ^DENT(221,"AC",Z3,X1),^DENT(221,"A",Z3,X1)
- +1 WRITE !,"Report released for transmission to Austin"
- +2 GOTO CLOSE
- W WRITE !!,"Stations have not been entered in the Dental Site Parameter file.",!,"You must enter a station before you can use this option"
- QUIT
- CLOSE XECUTE ^%ZIS("C")
- EXIT KILL %,%DT,%X,%Y,A,DENTA,DENTC,DENTED,DENTF,DENTF1,DENTSD,DENTV,DIC,H1,H2,H5,I,J,K,N,O,Q,Q1,S,X,X1,XMDUZ,XMSUB,XMTEXT,XMY,Y,Z1,Z2,Z3,Z5
- EXIT1 KILL ^UTILITY($JOB,"DENTERR"),^UTILITY($JOB,"DENTV"),^UTILITY($JOB,"DENTR"),^UTILITY($JOB,"DENTP")
- if $DATA(ZTSK)
- KILL ^%ZTSK(ZTSK)
- QUIT
- OPT ;;REVIEW TREATMENT DATA SERVICE REPORTS;OPTION;DENTAR1
- +1 ;;PROVIDER SUMMARY;PROV
- +2 ;;SITTINGS BY PROVIDER;SITPROV
- +3 ;;CLINIC SUMMARY;CLINIC
- +4 ;;INDIVIDUAL SITTINGS;SIT
- +5 ;;NO REVIEW;NOREV