source: FOIAVistA/tag/r/DENTAL-DEN/DENTE1.m@ 1410

Last change on this file since 1410 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.5 KB
Line 
1DENTE1 ;ISC2/SAW,HAG-EDIT DENTAL TREATMENT DATA ;1/26/98 15:10
2 ;;1.2;DENTAL;**16,19,17,20,24,26**;Jan 26, 1989
3TREAT0 ;REVIEW SERVICE REPORT DATA FULL SCREEN (TERMINAL INPUT)
4 S DENTFULS=1
5TREAT ;REVIEW SERVICE REPORT DATA LINE BY LINE (TERMINAL INPUT)
6 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).",!!
7 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
8 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
9TRT 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
10 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
11TREAT1 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
12 S DA=DENTDA D:$D(^DENT(221,DA,0)) ^DENTEC Q:$D(DENTREL) L G TREAT
13PERS ;PERSONNEL SERVICE REPORT DATA
14 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
15 D LOCK G:DENTL=0 PERS
16PERS1 S DJDN=DA,DJSC=$S($D(DENTREL):"DENTPERSM",1:"DENTPERS") D EN^DENTD Q:$D(DENTREL) L G PERS
17FEE ;FEE BASIS SERVICE REPORT DATA
18 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
19 D LOCK G:DENTL=0 FEE
20FEE1 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)
21 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."
22Q Q:$D(DENTREL) L G FEE
23ADMIN ;CLASS I-VI ADMIN SERVICE REPORT INFO
24 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
25 D LOCK G:DENTL=0 ADMIN
26ADMIN1 S DJDN=DA,DJSC=$S($D(DENTREL):"DENTCLASSM",1:"DENTCLASS") D EN^DENTD Q:$D(DENTREL) L G ADMIN
27DELTR ;DELETE TREATMENT DATA
28 W !! S DIC="^DENT(221,",DIC(0)="AEQMN" D ^DIC G:Y<0 EXIT S (DENT,DA)=+Y D LOCK G DELTR:DENTL=0
29TR1 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
30 S (DJDN,DA)=DENT,DJSC="DENTGENU",DJDIS=1 D EN^DENTD G:'$D(DJRJ) EXIT
31TR2 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
32 S (DIK,DIC)="^DENT(221,",DA=DENT D ^DIK W !!,"Entry deleted." R X:2 G DELTR
33IEN1 ;GENERATE INTERNAL ENTRY NUMBER FOR FILE 221
34 S X=$$CHECK(221,X) S DINUM=$$IEN(X) Q
35IEN6 ;GENERATE INTERNAL ENTRY NUMBER FOR FILE 226
36 S X=$$CHECK(226,X) S DINUM=$$IEN(X)
37 Q
38CHECK(FILE,CD) ;FIND A PLACE TO PUT THE NEW RECORD
39 N MO,AD,YR,FL
40 S FL="",FL=$O(^DENT(FILE,"B",CD,FL))
41 I FL="" Q CD
42 F D Q:FL="" ; Do it until empty
43 .S YR=$E(CD,1,3),MO=$E(CD,4,5),AD=$E(CD,6,7),FL=""
44 .S CD=CD+.000001 ; Add a second if date/time exist
45 .I $E(CD,13,14)>59 D ; CHECK SECOUNDS
46 ..S CD=CD+.000040
47 ..I $E(CD,11,12)>59 D ; CHECK MINUTES
48 ...S CD=CD+.004000
49 ...I $E(CD,9,10)>23 D ; CHECK HOURS
50 ....S AD=AD+1,MD=$P($T(DATE),";",MO+2)
51 ....S:+MO=2 MD=MD+$$LEAP(1700+YR)
52 ....I AD>MD D ; CHECK DAYS
53 .....S AD="01",MO=MO+1
54 .....I MO>12 S YR=YR+1,MO="01" ; CHECK MONTH
55 .S CD=YR_MO_AD_"."_$P(CD,".",2)
56 .S FL=$O(^DENT(FILE,"B",CD,FL))
57 Q CD
58IEN(CD) ;GENERATE INTERNAL ENTRY NUMBER
59 Q 9999999-CD
60 Q
61LEAP(LYR) ; Pass 4 digit YR to calculate whether Feb is 28 or 29 days.
62 N FLG
63 S FLG=$S(LYR#400=0:1,LYR#4=0&'(LYR#100=0):1,1:0)
64 Q FLG
65DATE ;;31;28;31;30;31;30;31;31;30;31;30;31
66LOCK ;LOCK GLOBAL THAT IS BEING ACCESSED BY ANOTHER USER
67 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
68EXIT 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
Note: See TracBrowser for help on using the repository browser.