Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DENTE1

DENTE1.m

Go to the documentation of this file.
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