- DENTAR ;ISC2/SAW,HAG-RELEASE DENTAL SERVICE REPORTS FOR TRANSMISSION TO AUSTIN ;9/11/89 15:57 ;11/24/87 9:51 AM
- ;;1.2;DENTAL;**2,8,24,25**;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
- ALL D ^DENTARA G CLOSE
- ADM S X1=3,X3=223,X4="I $P(^(0),U,29)=DENTSTA&$S('$D(^(.1)):1,1:$P(^(.1),U,1)="""")" G REL
- PERS S X1=4,X3=224,X4="I $P(^(0),U,10)=DENTSTA&$S('$D(^(.1)):1,1:$P(^(.1),U,1)="""")" G REL
- FEE S X1=5,X3=222,X4="I $P(^(0),U,28)=DENTSTA&$S('$D(^(.1)):1,1:$P(^(.1),U,1)="""")"
- REL W !! S U="^",Z1=0 G:'$D(^DENT(225,0)) W F Z2=0:1:2 S Z1=$O(^(Z1)) Q:Z1'>0 S K2=Z1
- G:Z2=0 W I Z2>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 G EXIT:Y<0 K DIC("A"),DIC("B")
- S Z=$S(Z2=1:K2,1:+Y) S (DENTSTA,Z2)=$P(^DENT(225,Z,0),U,1) G W:DENTSTA=""
- S DIC="^DENT("_X3_",",DIC(0)="AEMQZ",DIC("S")=X4 D ^DIC G EXIT:Y<0 S DENT1=+Y,DENTY0=Y(0) K DIC("S")
- S:$L(DENTSTA)=3 DENTSTA=DENTSTA_" " S (DENT,Z)=$P(Y(0),U,1),Z1=1700+$E(Z,1,3),Z=+$E(Z,4,5)+2,Z=$P($T(DATE),";",Z),Z1=Z_" "_Z1
- S X2="^DENTAR"_X1,%ZIS="MQ" K IO("Q") D ^%ZIS G EXIT:IO=""
- I $D(IO("Q")) S ZTRTN="QUE^DENTAR",ZTSAVE("DENT*")="",ZTSAVE("X2")="",ZTSAVE("DENTY0")="",ZTSAVE("Z1")="",ZTSAVE("Z2")="",ZTSAVE("U")="" D ^%ZTLOAD K ZTSK,ZTRTN,ZTSAVE G CLOSE
- QUE U IO D @X2 U IO(0) G CLOSE:$D(ZTSK)!(IO'=IO(0))!($D(DENTF))!($E(IOST)'="C")
- 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 DENT=DENT_" ",DENT=$E(DENT,1,80),DENT=DENT_"$"
- S DENTA=$S($E(DENTSTA,4,5)=" ":+DENTSTA,1:DENTSTA),DENTA=$O(^DENT(225,"B",DENTA,0))
- I DENTA,$D(^DENT(225,DENTA,0)),$P(^(0),"^",3)="Y" S XMDUZ=DUZ,XMY(DUZ)="",XMY("XXX@Q-DAS.DOMAIN.EXT")="",XMSUB=Z1_", "_Z3,X(1,0)=DENT,XMTEXT="X(" D ^XMD G M
- S Z=$S($D(^UTILITY("DENTV")):^("DENTV")+1,1:1),^UTILITY("DENTV",Z,0)=DENT,^UTILITY("DENTV")=Z
- M S ^DENT(X3,DENT1,.1)=DUZ_"^"_DT I X3=224 S X="" F I=0:0 S X=$O(^UTILITY($J,"DENTP",X)) Q:X="" S X1=$P(^(X),".",1),^DENT(226,X,.1)=DUZ_"^"_DT K ^DENT(226,"A",Z2,X1,X)
- R !!,"Report released for transmission to Austin",R1:5
- 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" G EXIT
- DATE ;;JANUARY;FEBRUARY;MARCH;APRIL;MAY;JUNE;JULY;AUGUST;SEPTEMBER;OCTOBER;NOVEMBER;DECEMBER
- CLOSE X ^%ZIS("C")
- EXIT K %,A,DENT,DENTA,DENT1,DENT2,DENTF,DENTV,DENTY0,DIC,I,J,K,K2,O,R1,S,X,X1,X2,X3,X4,XMDUZ,XMSUB,XMTEXT,XMY,Y,Z,Z1,Z2,Z3,^UTILITY($J,"DENTP"),ZTRTN,ZTSAVE K:$D(ZTSK) ^%ZTSK(ZTSK),ZTSK Q
- OPT ;;RELEASE SERVICE REPORTS;OPTION;DENTAR
- ;;TREATMENT DATA REVIEW/RELEASE MENU;^DENTAR1
- ;;CLASS I-VI ADMIN INFO (TYPE 3);ADM
- ;;PERSONNEL INFO (TYPE 4);PERS
- ;;APPLICATIONS AND DENTAL FEE (TYPE 5);FEE
- ;;RELEASE ALL SERVICE REPORTS;ALL
- ;;CHECK DUPLICATE FOR SITTINGS;^DENTDUP
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDENTAR 3792 printed Dec 13, 2024@01:45:53 Page 2
- DENTAR ;ISC2/SAW,HAG-RELEASE DENTAL SERVICE REPORTS FOR TRANSMISSION TO AUSTIN ;9/11/89 15:57 ;11/24/87 9:51 AM
- +1 ;;1.2;DENTAL;**2,8,24,25**;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
- ALL DO ^DENTARA
- GOTO CLOSE
- ADM SET X1=3
- SET X3=223
- SET X4="I $P(^(0),U,29)=DENTSTA&$S('$D(^(.1)):1,1:$P(^(.1),U,1)="""")"
- GOTO REL
- PERS SET X1=4
- SET X3=224
- SET X4="I $P(^(0),U,10)=DENTSTA&$S('$D(^(.1)):1,1:$P(^(.1),U,1)="""")"
- GOTO REL
- FEE SET X1=5
- SET X3=222
- SET X4="I $P(^(0),U,28)=DENTSTA&$S('$D(^(.1)):1,1:$P(^(.1),U,1)="""")"
- REL WRITE !!
- SET U="^"
- SET Z1=0
- if '$DATA(^DENT(225,0))
- GOTO W
- FOR Z2=0:1:2
- SET Z1=$ORDER(^(Z1))
- if Z1'>0
- QUIT
- SET K2=Z1
- +1 if Z2=0
- GOTO W
- IF Z2>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
- GOTO EXIT
- KILL DIC("A"),DIC("B")
- +2 SET Z=$SELECT(Z2=1:K2,1:+Y)
- SET (DENTSTA,Z2)=$PIECE(^DENT(225,Z,0),U,1)
- if DENTSTA=""
- GOTO W
- +3 SET DIC="^DENT("_X3_","
- SET DIC(0)="AEMQZ"
- SET DIC("S")=X4
- DO ^DIC
- if Y<0
- GOTO EXIT
- SET DENT1=+Y
- SET DENTY0=Y(0)
- KILL DIC("S")
- +4 if $LENGTH(DENTSTA)=3
- SET DENTSTA=DENTSTA_" "
- SET (DENT,Z)=$PIECE(Y(0),U,1)
- SET Z1=1700+$EXTRACT(Z,1,3)
- SET Z=+$EXTRACT(Z,4,5)+2
- SET Z=$PIECE($TEXT(DATE),";",Z)
- SET Z1=Z_" "_Z1
- +5 SET X2="^DENTAR"_X1
- SET %ZIS="MQ"
- KILL IO("Q")
- DO ^%ZIS
- if IO=""
- GOTO EXIT
- +6 IF $DATA(IO("Q"))
- SET ZTRTN="QUE^DENTAR"
- SET ZTSAVE("DENT*")=""
- SET ZTSAVE("X2")=""
- SET ZTSAVE("DENTY0")=""
- SET ZTSAVE("Z1")=""
- SET ZTSAVE("Z2")=""
- SET ZTSAVE("U")=""
- DO ^%ZTLOAD
- KILL ZTSK,ZTRTN,ZTSAVE
- GOTO CLOSE
- QUE USE IO
- DO @X2
- USE IO(0)
- if $DATA(ZTSK)!(IO'=IO(0))!($DATA(DENTF))!($EXTRACT(IOST)'="C")
- GOTO CLOSE
- 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 DENT=DENT_" "
- SET DENT=$EXTRACT(DENT,1,80)
- SET DENT=DENT_"$"
- +1 SET DENTA=$SELECT($EXTRACT(DENTSTA,4,5)=" ":+DENTSTA,1:DENTSTA)
- SET DENTA=$ORDER(^DENT(225,"B",DENTA,0))
- +2 IF DENTA
- IF $DATA(^DENT(225,DENTA,0))
- IF $PIECE(^(0),"^",3)="Y"
- SET XMDUZ=DUZ
- SET XMY(DUZ)=""
- SET XMY("XXX@Q-DAS.DOMAIN.EXT")=""
- SET XMSUB=Z1_", "_Z3
- SET X(1,0)=DENT
- SET XMTEXT="X("
- DO ^XMD
- GOTO M
- +3 SET Z=$SELECT($DATA(^UTILITY("DENTV")):^("DENTV")+1,1:1)
- SET ^UTILITY("DENTV",Z,0)=DENT
- SET ^UTILITY("DENTV")=Z
- M SET ^DENT(X3,DENT1,.1)=DUZ_"^"_DT
- IF X3=224
- SET X=""
- FOR I=0:0
- SET X=$ORDER(^UTILITY($JOB,"DENTP",X))
- if X=""
- QUIT
- SET X1=$PIECE(^(X),".",1)
- SET ^DENT(226,X,.1)=DUZ_"^"_DT
- KILL ^DENT(226,"A",Z2,X1,X)
- +1 READ !!,"Report released for transmission to Austin",R1:5
- +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"
- GOTO EXIT
- DATE ;;JANUARY;FEBRUARY;MARCH;APRIL;MAY;JUNE;JULY;AUGUST;SEPTEMBER;OCTOBER;NOVEMBER;DECEMBER
- CLOSE XECUTE ^%ZIS("C")
- EXIT KILL %,A,DENT,DENTA,DENT1,DENT2,DENTF,DENTV,DENTY0,DIC,I,J,K,K2,O,R1,S,X,X1,X2,X3,X4,XMDUZ,XMSUB,XMTEXT,XMY,Y,Z,Z1,Z2,Z3,^UTILITY($JOB,"DENTP"),ZTRTN,ZTSAVE
- if $DATA(ZTSK)
- KILL ^%ZTSK(ZTSK),ZTSK
- QUIT
- OPT ;;RELEASE SERVICE REPORTS;OPTION;DENTAR
- +1 ;;TREATMENT DATA REVIEW/RELEASE MENU;^DENTAR1
- +2 ;;CLASS I-VI ADMIN INFO (TYPE 3);ADM
- +3 ;;PERSONNEL INFO (TYPE 4);PERS
- +4 ;;APPLICATIONS AND DENTAL FEE (TYPE 5);FEE
- +5 ;;RELEASE ALL SERVICE REPORTS;ALL
- +6 ;;CHECK DUPLICATE FOR SITTINGS;^DENTDUP