source: FOIAVistA/trunk/r/DENTAL-DEN/DENTCRD.m@ 1800

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

initial load of FOIAVistA 6/30/08 version

File size: 2.7 KB
Line 
1DENTCRD ;ISC2/WCD,SAW-PROCESS DENTAL SERVICE CARD ;8/15/96 15:39
2 ;;1.2;DENTAL;**16,19,21**;JAN 26, 1989
3 S (DENTVAL,DENTERR,DENTNCR,Z1)=0,U="^" G:'$D(^DENT(225,0)) W F Z3=0:1:2 S Z1=$O(^(Z1)) Q:Z1'>0 S Z2=Z1
4 G:Z3=0 W I Z3>1 S DIC="^DENT(225,",DIC(0)="AEMNQZ" D ^DIC G EXIT:Y<0
5 S Z=$S(Z3=1:Z2,1:+Y) G W:'$D(^DENT(225,Z,0))
6 S IOP=$P(^(0),"^",2),DENTSTA=$P(^(0),"^",1) G W:IOP=""
7 S DENTY=0 I $E(DT,4,5)'="01" G NXT
8 I $E(DT,6,7)<16 W ! K DIR S DIR(0)="YAO",DIR("A")="Enter Cards From Last December? ",DIR("B")="YES" D ^DIR G:$D(DIROUT)!($D(DIRUT)) EXIT K DIR,DIROUT,DIRUT S DENTY=Y
9NXT D ^%ZIS I POP W !,"The card reader port is in use. Try again later" S IOP=$I D ^%ZIS G EXIT
10 K IOP,DA U IO X ^%ZOSF("TYPE-AHEAD") U IO(0) W !,?15,"READ DENTAL CARDS FROM MARK SENSE CARD READER",!!,"You may begin inserting cards"
11READCRD ;
12 W:DENTNCR !,"Finished Processing Card Number: ",$J(DENTNCR,4)
13 U IO R D:30 I '$T!($E(D,2,5)=9999) X ^%ZIS("C") U IO(0) W !,"Time Expired/End of Session" G SUM
14 U IO(0) S DENTNCR=DENTNCR+1 G:D="" W1 S D=$E(D,2,75) F I=1:1:74 I "0123456789 "'[$E(D,I) G W1
15 I +$E(D,5,13)=2 S DENT=1,E=0 D NCT^DENTCRD2 K D,DENT,E G READCRD
16 D EN^DENTCRD1 I '$D(D2) S DENTERR=DENTERR+1 K D G READCRD
17 I '$D(^DENT(221,0)) W !!,"YOUR DENTAL TREATMENT FILE IS NOT SET UP PROPERLY",!,"CONTACT YOUR SITE MANAGER",*7 U IO X ^%ZIS("C") G EXIT
18 S N1=$P(^DENT(221,0),"^",4),N1=N1+1,N=$P(D2,"^")
19 D SAVE(221,D2,.N) ;file record and return IEN
20 S ^DENT(221,0)=$P(^DENT(221,0),"^",1,2)_"^"_N_"^"_N1,DENTVAL=DENTVAL+1
21 S X=$P(D2,"^",39) G:X=""!(X="GROUP")!('$D(D39)) Q I '$D(^DENT(220,0)) S ^DENT(220,0)="DENTAL PATIENT^220P^^"
22 I '$D(^DENT(220,D39,0)) S ^DENT(220,D39,0)=D39,^DENT(220,"B",D39,D39)="",^DENT(220,0)=$P(^DENT(220,0),"^",1,2)_"^"_D39_"^"_($P(^DENT(220,0),"^",4)+1)
23Q K D,D2,X,D39 G READCRD
24W W !!,"A card reader device has not been entered for your station in the Dental Site",!,"Parameter file. One must be entered before you can run this option",*7 G EXIT
25W1 W !,"This card is unreadable -- Remove and correct card. Check for extraneous marks",*7 K D S DENTERR=DENTERR+1 G READCRD
26SUM W !!,?5,"----- SESSION COMPLETE -----",!,?5,"Total Cards Read: ",DENTNCR
27 W !,?5,"Total Errors: ",DENTERR,!,?5,"Total Valid: ",DENTVAL
28 W:DENTERR !,"**NOTE** Cards that had errors must be corrected and reread thru the card reader"
29EXIT K D,D2,DENT,DENTERR,DENTNCR,DENTSTA,DENTVAL,DENTXX1,DENTY,DIC,DIR,E,I,IOP,N,N1,X,XX1,Y,Z,Z1,Z2,Z3,ZZ Q
30SAVE(FILE,VAR,REC) ; Stuff and index the dental record, return IEN
31 N DIC,DIE,X,DA
32 S X=$P(VAR,U,1)
33 ;execute input transform which converts the date to a unique
34 ;inverse date/time & returns DINUM
35 X $P(^DD(FILE,.01,0),U,5,99)
36 S DIC="^DENT("_FILE_",",DIC(0)="EZ",DIC("DR")="" D FILE^DICN S REC=+Y
37 S ^DENT(FILE,REC,0)=VAR S DA=REC,DIK="^DENT("_FILE_"," D IX^DIK
38 Q
Note: See TracBrowser for help on using the repository browser.