69 lines
4.5 KiB
Mathematica
69 lines
4.5 KiB
Mathematica
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
|