DENTE1 ;ISC2/SAW,HAG-EDIT DENTAL TREATMENT DATA ;1/26/98 15:10
;;1.2;DENTAL;**16,19,17,20,24,26**;Jan 26, 1989
TREAT0 ;REVIEW SERVICE REPORT DATA FULL SCREEN (TERMINAL INPUT)
S DENTFULS=1
TREAT ;REVIEW SERVICE REPORT DATA LINE BY LINE (TERMINAL INPUT)
W !!,"You may select a treatment date by entering the patient's name or SSN,",!,"the provider's number or the treatment date (without time).",!!
K DENTFUL S DIC="^DENT(221,",DIC(0)="ALEMNQZ",DIC("DR")=".3;.5",DLAYGO=221 D ^DIC K DLAYGO G:Y<0 EXIT S DA=+Y D LOCK G TREAT:DENTL=0 S X=$E($P(Y(0),"^",10),2) S:$D(DENTFULS) DENTFUL=1
I $D(^DENT(221,DA,.1)) W *7,!!,"Note: This treatment data has already been RELEASED.",!,?6,"RELEASED data can not be edited it can only be viewed.",! R Z:5 G TREAT1
TRT I '$D(DENTFUL) S DIE="^DENT(221,",X=$E($P(Y(0),"^",10),2) K DR S DR="[DENT"_$S(X=1:"ENDU]",X=2!(X=3):"ORAU]",X=6:"PERIU]",1:"GENU]"),DENTDR=DR
I '$D(DENTFUL) S:$D(DENTREL) DR=$P(DR,"U]",1)_"M]" S DENTDR=DR,(DENTDA,DENTK1)=DA D ^DIE D:$D(DA) ^DENTEC,^DENTUPD Q:$D(DENTREL) L G TREAT
TREAT1 S (DENTDA,DJDN)=DA,(DENTSC,DJSC)="DENT"_$S(X=1:"ENDU",X=2!(X=3):"ORAU",X=6:"PERIU",1:"GENU") S:$D(DENTREL) (DENTSC,DJSC)=$P(DJSC,"U",1)_"M" S:$D(^DENT(221,DA,.1))&'$D(DENTREL) DJDIS=1 D EN^DENTD
S DA=DENTDA D:$D(^DENT(221,DA,0)) ^DENTEC Q:$D(DENTREL) L G TREAT
PERS ;PERSONNEL SERVICE REPORT DATA
W !! S DIC="^DENT(224,",DIC("S")="I '$D(^DENT(224,+Y,.1))",DIC(0)="ALEQMZ",DLAYGO=224 D ^DIC K DLAYGO G:Y<0 EXIT S (DA,DENT,DENTDA)=+Y,STA=10,H=224 I $P(Y,"^",3) D CHK^DENTE0 I $D(DENTF) K DENTF G PERS
D LOCK G:DENTL=0 PERS
PERS1 S DJDN=DA,DJSC=$S($D(DENTREL):"DENTPERSM",1:"DENTPERS") D EN^DENTD Q:$D(DENTREL) L G PERS
FEE ;FEE BASIS SERVICE REPORT DATA
W !! S DIC="^DENT(222,",DIC("S")="I '$D(^DENT(222,+Y,.1))",DIC(0)="ALEQMZ",DLAYGO=222 D ^DIC K DLAYGO G:Y<0 EXIT S (DA,DENT,DENTDA)=+Y,STA=28,H=222 I $P(Y,"^",3) D CHK^DENTE0 I $D(DENTF) K DENTF G FEE
D LOCK G:DENTL=0 FEE
FEE1 S DJDN=DA,DJSC=$S($D(DENTREL):"DENTFEEM",1:"DENTFEE") D EN^DENTD G:'$O(^DENT(222,DENT,0)) Q S X=0,X1=^DENT(222,DENT,0) F I=14:1:22 S X=X+$P(X1,"^",I)
I $P(^DENT(222,DENT,0),"^",13)'=X S $P(^(0),"^",13)=X W *7,!!,"FEE TREAT COMP value was incorrect and has been recalculated for you."
Q Q:$D(DENTREL) L G FEE
ADMIN ;CLASS I-VI ADMIN SERVICE REPORT INFO
W !! S DIC="^DENT(223,",DIC("S")="I '$D(^DENT(223,+Y,.1))",DIC(0)="ALEQMZ",DLAYGO=223 D ^DIC K DLAYGO G:Y<0 EXIT S (DA,DENT,DENTDA)=+Y,STA=29,H=223 I $P(Y,"^",3) D CHK^DENTE0 I $D(DENTF) K DENTF G ADMIN
D LOCK G:DENTL=0 ADMIN
ADMIN1 S DJDN=DA,DJSC=$S($D(DENTREL):"DENTCLASSM",1:"DENTCLASS") D EN^DENTD Q:$D(DENTREL) L G ADMIN
DELTR ;DELETE TREATMENT DATA
W !! S DIC="^DENT(221,",DIC(0)="AEQMN" D ^DIC G:Y<0 EXIT S (DENT,DA)=+Y D LOCK G DELTR:DENTL=0
TR1 W !!,"Would you like a display of the data for this Treatment Data entry" S %=1 D YN^DICN D:%=0 Q1^DENTE0 G TR1:%=0,TR2:%=2 I %<0 L G DELTR
S (DJDN,DA)=DENT,DJSC="DENTGENU",DJDIS=1 D EN^DENTD G:'$D(DJRJ) EXIT
TR2 W !!,"Are you sure you want to delete this entry" S %=2 D YN^DICN D:%=0 Q2^DENTE0 G TR2:%=0 I %'=1 L W !,"Nothing Deleted" G DELTR
S (DIK,DIC)="^DENT(221,",DA=DENT D ^DIK W !!,"Entry deleted." R X:2 G DELTR
IEN1 ;GENERATE INTERNAL ENTRY NUMBER FOR FILE 221
S X=$$CHECK(221,X) S DINUM=$$IEN(X) Q
IEN6 ;GENERATE INTERNAL ENTRY NUMBER FOR FILE 226
S X=$$CHECK(226,X) S DINUM=$$IEN(X)
Q
CHECK(FILE,CD) ;FIND A PLACE TO PUT THE NEW RECORD
N MO,AD,YR,FL
S FL="",FL=$O(^DENT(FILE,"B",CD,FL))
I FL="" Q CD
F D Q:FL="" ; Do it until empty
.S YR=$E(CD,1,3),MO=$E(CD,4,5),AD=$E(CD,6,7),FL=""
.S CD=CD+.000001 ; Add a second if date/time exist
.I $E(CD,13,14)>59 D ; CHECK SECOUNDS
..S CD=CD+.000040
..I $E(CD,11,12)>59 D ; CHECK MINUTES
...S CD=CD+.004000
...I $E(CD,9,10)>23 D ; CHECK HOURS
....S AD=AD+1,MD=$P($T(DATE),";",MO+2)
....S:+MO=2 MD=MD+$$LEAP(1700+YR)
....I AD>MD D ; CHECK DAYS
.....S AD="01",MO=MO+1
.....I MO>12 S YR=YR+1,MO="01" ; CHECK MONTH
.S CD=YR_MO_AD_"."_$P(CD,".",2)
.S FL=$O(^DENT(FILE,"B",CD,FL))
Q CD
IEN(CD) ;GENERATE INTERNAL ENTRY NUMBER
Q 9999999-CD
Q
LEAP(LYR) ; Pass 4 digit YR to calculate whether Feb is 28 or 29 days.
N FLG
S FLG=$S(LYR#400=0:1,LYR#4=0&'(LYR#100=0):1,1:0)
Q FLG
DATE ;;31;28;31;30;31;30;31;31;30;31;30;31
LOCK ;LOCK GLOBAL THAT IS BEING ACCESSED BY ANOTHER USER
L @(DIC_DA_"):1") S DENTL=$T Q:DENTL'=0 I DENTL=0 W !!,*7,"THIS ENTRY IS BEING EDITED BY ANOTHER USER. TRY LATER." Q
EXIT K DA,DENT,DENTDA,DENTDR,DENTF,DENTL,DENTFUL,DENTFULS,DENTK1,DENTSC,DENTSTA,DENTSTA2,DIC,DIE,DJDN,DJSC,DR,DT1,H,I,K,K1,STA,V,X,X1,Z Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDENTE1 4632 printed Dec 13, 2024@01:46:35 Page 2
DENTE1 ;ISC2/SAW,HAG-EDIT DENTAL TREATMENT DATA ;1/26/98 15:10
+1 ;;1.2;DENTAL;**16,19,17,20,24,26**;Jan 26, 1989
TREAT0 ;REVIEW SERVICE REPORT DATA FULL SCREEN (TERMINAL INPUT)
+1 SET DENTFULS=1
TREAT ;REVIEW SERVICE REPORT DATA LINE BY LINE (TERMINAL INPUT)
+1 WRITE !!,"You may select a treatment date by entering the patient's name or SSN,",!,"the provider's number or the treatment date (without time).",!!
+2 KILL DENTFUL
SET DIC="^DENT(221,"
SET DIC(0)="ALEMNQZ"
SET DIC("DR")=".3;.5"
SET DLAYGO=221
DO ^DIC
KILL DLAYGO
if Y<0
GOTO EXIT
SET DA=+Y
DO LOCK
if DENTL=0
GOTO TREAT
SET X=$EXTRACT($PIECE(Y(0),"^",10),2)
if $DATA(DENTFULS)
SET DENTFUL=1
+3 IF $DATA(^DENT(221,DA,.1))
WRITE *7,!!,"Note: This treatment data has already been RELEASED.",!,?6,"RELEASED data can not be edited it can only be viewed.",!
READ Z:5
GOTO TREAT1
TRT IF '$DATA(DENTFUL)
SET DIE="^DENT(221,"
SET X=$EXTRACT($PIECE(Y(0),"^",10),2)
KILL DR
SET DR="[DENT"_$SELECT(X=1:"ENDU]",X=2!(X=3):"ORAU]",X=6:"PERIU]",1:"GENU]")
SET DENTDR=DR
+1 IF '$DATA(DENTFUL)
if $DATA(DENTREL)
SET DR=$PIECE(DR,"U]",1)_"M]"
SET DENTDR=DR
SET (DENTDA,DENTK1)=DA
DO ^DIE
if $DATA(DA)
DO ^DENTEC
DO ^DENTUPD
if $DATA(DENTREL)
QUIT
LOCK
GOTO TREAT
TREAT1 SET (DENTDA,DJDN)=DA
SET (DENTSC,DJSC)="DENT"_$SELECT(X=1:"ENDU",X=2!(X=3):"ORAU",X=6:"PERIU",1:"GENU")
if $DATA(DENTREL)
SET (DENTSC,DJSC)=$PIECE(DJSC,"U",1)_"M"
if $DATA(^DENT(221,DA,.1))&'$DATA(DENTREL)
SET DJDIS=1
DO EN^DENTD
+1 SET DA=DENTDA
if $DATA(^DENT(221,DA,0))
DO ^DENTEC
if $DATA(DENTREL)
QUIT
LOCK
GOTO TREAT
PERS ;PERSONNEL SERVICE REPORT DATA
+1 WRITE !!
SET DIC="^DENT(224,"
SET DIC("S")="I '$D(^DENT(224,+Y,.1))"
SET DIC(0)="ALEQMZ"
SET DLAYGO=224
DO ^DIC
KILL DLAYGO
if Y<0
GOTO EXIT
SET (DA,DENT,DENTDA)=+Y
SET STA=10
SET H=224
IF $PIECE(Y,"^",3)
DO CHK^DENTE0
IF $DATA(DENTF)
KILL DENTF
GOTO PERS
+2 DO LOCK
if DENTL=0
GOTO PERS
PERS1 SET DJDN=DA
SET DJSC=$SELECT($DATA(DENTREL):"DENTPERSM",1:"DENTPERS")
DO EN^DENTD
if $DATA(DENTREL)
QUIT
LOCK
GOTO PERS
FEE ;FEE BASIS SERVICE REPORT DATA
+1 WRITE !!
SET DIC="^DENT(222,"
SET DIC("S")="I '$D(^DENT(222,+Y,.1))"
SET DIC(0)="ALEQMZ"
SET DLAYGO=222
DO ^DIC
KILL DLAYGO
if Y<0
GOTO EXIT
SET (DA,DENT,DENTDA)=+Y
SET STA=28
SET H=222
IF $PIECE(Y,"^",3)
DO CHK^DENTE0
IF $DATA(DENTF)
KILL DENTF
GOTO FEE
+2 DO LOCK
if DENTL=0
GOTO FEE
FEE1 SET DJDN=DA
SET DJSC=$SELECT($DATA(DENTREL):"DENTFEEM",1:"DENTFEE")
DO EN^DENTD
if '$ORDER(^DENT(222,DENT,0))
GOTO Q
SET X=0
SET X1=^DENT(222,DENT,0)
FOR I=14:1:22
SET X=X+$PIECE(X1,"^",I)
+1 IF $PIECE(^DENT(222,DENT,0),"^",13)'=X
SET $PIECE(^(0),"^",13)=X
WRITE *7,!!,"FEE TREAT COMP value was incorrect and has been recalculated for you."
Q if $DATA(DENTREL)
QUIT
LOCK
GOTO FEE
ADMIN ;CLASS I-VI ADMIN SERVICE REPORT INFO
+1 WRITE !!
SET DIC="^DENT(223,"
SET DIC("S")="I '$D(^DENT(223,+Y,.1))"
SET DIC(0)="ALEQMZ"
SET DLAYGO=223
DO ^DIC
KILL DLAYGO
if Y<0
GOTO EXIT
SET (DA,DENT,DENTDA)=+Y
SET STA=29
SET H=223
IF $PIECE(Y,"^",3)
DO CHK^DENTE0
IF $DATA(DENTF)
KILL DENTF
GOTO ADMIN
+2 DO LOCK
if DENTL=0
GOTO ADMIN
ADMIN1 SET DJDN=DA
SET DJSC=$SELECT($DATA(DENTREL):"DENTCLASSM",1:"DENTCLASS")
DO EN^DENTD
if $DATA(DENTREL)
QUIT
LOCK
GOTO ADMIN
DELTR ;DELETE TREATMENT DATA
+1 WRITE !!
SET DIC="^DENT(221,"
SET DIC(0)="AEQMN"
DO ^DIC
if Y<0
GOTO EXIT
SET (DENT,DA)=+Y
DO LOCK
if DENTL=0
GOTO DELTR
TR1 WRITE !!,"Would you like a display of the data for this Treatment Data entry"
SET %=1
DO YN^DICN
if %=0
DO Q1^DENTE0
if %=0
GOTO TR1
if %=2
GOTO TR2
IF %<0
LOCK
GOTO DELTR
+1 SET (DJDN,DA)=DENT
SET DJSC="DENTGENU"
SET DJDIS=1
DO EN^DENTD
if '$DATA(DJRJ)
GOTO EXIT
TR2 WRITE !!,"Are you sure you want to delete this entry"
SET %=2
DO YN^DICN
if %=0
DO Q2^DENTE0
if %=0
GOTO TR2
IF %'=1
LOCK
WRITE !,"Nothing Deleted"
GOTO DELTR
+1 SET (DIK,DIC)="^DENT(221,"
SET DA=DENT
DO ^DIK
WRITE !!,"Entry deleted."
READ X:2
GOTO DELTR
IEN1 ;GENERATE INTERNAL ENTRY NUMBER FOR FILE 221
+1 SET X=$$CHECK(221,X)
SET DINUM=$$IEN(X)
QUIT
IEN6 ;GENERATE INTERNAL ENTRY NUMBER FOR FILE 226
+1 SET X=$$CHECK(226,X)
SET DINUM=$$IEN(X)
+2 QUIT
CHECK(FILE,CD) ;FIND A PLACE TO PUT THE NEW RECORD
+1 NEW MO,AD,YR,FL
+2 SET FL=""
SET FL=$ORDER(^DENT(FILE,"B",CD,FL))
+3 IF FL=""
QUIT CD
+4 ; Do it until empty
FOR
Begin DoDot:1
+5 SET YR=$EXTRACT(CD,1,3)
SET MO=$EXTRACT(CD,4,5)
SET AD=$EXTRACT(CD,6,7)
SET FL=""
+6 ; Add a second if date/time exist
SET CD=CD+.000001
+7 ; CHECK SECOUNDS
IF $EXTRACT(CD,13,14)>59
Begin DoDot:2
+8 SET CD=CD+.000040
+9 ; CHECK MINUTES
IF $EXTRACT(CD,11,12)>59
Begin DoDot:3
+10 SET CD=CD+.004000
+11 ; CHECK HOURS
IF $EXTRACT(CD,9,10)>23
Begin DoDot:4
+12 SET AD=AD+1
SET MD=$PIECE($TEXT(DATE),";",MO+2)
+13 if +MO=2
SET MD=MD+$$LEAP(1700+YR)
+14 ; CHECK DAYS
IF AD>MD
Begin DoDot:5
+15 SET AD="01"
SET MO=MO+1
+16 ; CHECK MONTH
IF MO>12
SET YR=YR+1
SET MO="01"
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
+17 SET CD=YR_MO_AD_"."_$PIECE(CD,".",2)
+18 SET FL=$ORDER(^DENT(FILE,"B",CD,FL))
End DoDot:1
if FL=""
QUIT
+19 QUIT CD
IEN(CD) ;GENERATE INTERNAL ENTRY NUMBER
+1 QUIT 9999999-CD
+2 QUIT
LEAP(LYR) ; Pass 4 digit YR to calculate whether Feb is 28 or 29 days.
+1 NEW FLG
+2 SET FLG=$SELECT(LYR#400=0:1,LYR#4=0&'(LYR#100=0):1,1:0)
+3 QUIT FLG
DATE ;;31;28;31;30;31;30;31;31;30;31;30;31
LOCK ;LOCK GLOBAL THAT IS BEING ACCESSED BY ANOTHER USER
+1 LOCK @(DIC_DA_"):1")
SET DENTL=$TEST
if DENTL'=0
QUIT
IF DENTL=0
WRITE !!,*7,"THIS ENTRY IS BEING EDITED BY ANOTHER USER. TRY LATER."
QUIT
EXIT KILL DA,DENT,DENTDA,DENTDR,DENTF,DENTL,DENTFUL,DENTFULS,DENTK1,DENTSC,DENTSTA,DENTSTA2,DIC,DIE,DJDN,DJSC,DR,DT1,H,I,K,K1,STA,V,X,X1,Z
QUIT
