DENTCRD ;ISC2/WCD,SAW-PROCESS DENTAL SERVICE CARD ;8/15/96 15:39
;;1.2;DENTAL;**16,19,21**;JAN 26, 1989
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
G:Z3=0 W I Z3>1 S DIC="^DENT(225,",DIC(0)="AEMNQZ" D ^DIC G EXIT:Y<0
S Z=$S(Z3=1:Z2,1:+Y) G W:'$D(^DENT(225,Z,0))
S IOP=$P(^(0),"^",2),DENTSTA=$P(^(0),"^",1) G W:IOP=""
S DENTY=0 I $E(DT,4,5)'="01" G NXT
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
NXT D ^%ZIS I POP W !,"The card reader port is in use. Try again later" S IOP=$I D ^%ZIS G EXIT
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"
READCRD ;
W:DENTNCR !,"Finished Processing Card Number: ",$J(DENTNCR,4)
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
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
I +$E(D,5,13)=2 S DENT=1,E=0 D NCT^DENTCRD2 K D,DENT,E G READCRD
D EN^DENTCRD1 I '$D(D2) S DENTERR=DENTERR+1 K D G READCRD
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
S N1=$P(^DENT(221,0),"^",4),N1=N1+1,N=$P(D2,"^")
D SAVE(221,D2,.N) ;file record and return IEN
S ^DENT(221,0)=$P(^DENT(221,0),"^",1,2)_"^"_N_"^"_N1,DENTVAL=DENTVAL+1
S X=$P(D2,"^",39) G:X=""!(X="GROUP")!('$D(D39)) Q I '$D(^DENT(220,0)) S ^DENT(220,0)="DENTAL PATIENT^220P^^"
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)
Q K D,D2,X,D39 G READCRD
W 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
W1 W !,"This card is unreadable -- Remove and correct card. Check for extraneous marks",*7 K D S DENTERR=DENTERR+1 G READCRD
SUM W !!,?5,"----- SESSION COMPLETE -----",!,?5,"Total Cards Read: ",DENTNCR
W !,?5,"Total Errors: ",DENTERR,!,?5,"Total Valid: ",DENTVAL
W:DENTERR !,"**NOTE** Cards that had errors must be corrected and reread thru the card reader"
EXIT 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
SAVE(FILE,VAR,REC) ; Stuff and index the dental record, return IEN
N DIC,DIE,X,DA
S X=$P(VAR,U,1)
;execute input transform which converts the date to a unique
;inverse date/time & returns DINUM
X $P(^DD(FILE,.01,0),U,5,99)
S DIC="^DENT("_FILE_",",DIC(0)="EZ",DIC("DR")="" D FILE^DICN S REC=+Y
S ^DENT(FILE,REC,0)=VAR S DA=REC,DIK="^DENT("_FILE_"," D IX^DIK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDENTCRD 2845 printed Sep 23, 2025@19:22:06 Page 2
DENTCRD ;ISC2/WCD,SAW-PROCESS DENTAL SERVICE CARD ;8/15/96 15:39
+1 ;;1.2;DENTAL;**16,19,21**;JAN 26, 1989
+2 SET (DENTVAL,DENTERR,DENTNCR,Z1)=0
SET U="^"
if '$DATA(^DENT(225,0))
GOTO W
FOR Z3=0:1:2
SET Z1=$ORDER(^(Z1))
if Z1'>0
QUIT
SET Z2=Z1
+3 if Z3=0
GOTO W
IF Z3>1
SET DIC="^DENT(225,"
SET DIC(0)="AEMNQZ"
DO ^DIC
if Y<0
GOTO EXIT
+4 SET Z=$SELECT(Z3=1:Z2,1:+Y)
if '$DATA(^DENT(225,Z,0))
GOTO W
+5 SET IOP=$PIECE(^(0),"^",2)
SET DENTSTA=$PIECE(^(0),"^",1)
if IOP=""
GOTO W
+6 SET DENTY=0
IF $EXTRACT(DT,4,5)'="01"
GOTO NXT
+7 IF $EXTRACT(DT,6,7)<16
WRITE !
KILL DIR
SET DIR(0)="YAO"
SET DIR("A")="Enter Cards From Last December? "
SET DIR("B")="YES"
DO ^DIR
if $DATA(DIROUT)!($DATA(DIRUT))
GOTO EXIT
KILL DIR,DIROUT,DIRUT
SET DENTY=Y
NXT DO ^%ZIS
IF POP
WRITE !,"The card reader port is in use. Try again later"
SET IOP=$IO
DO ^%ZIS
GOTO EXIT
+1 KILL IOP,DA
USE IO
XECUTE ^%ZOSF("TYPE-AHEAD")
USE IO(0)
WRITE !,?15,"READ DENTAL CARDS FROM MARK SENSE CARD READER",!!,"You may begin inserting cards"
READCRD ;
+1 if DENTNCR
WRITE !,"Finished Processing Card Number: ",$JUSTIFY(DENTNCR,4)
+2 USE IO
READ D:30
IF '$TEST!($EXTRACT(D,2,5)=9999)
XECUTE ^%ZIS("C")
USE IO(0)
WRITE !,"Time Expired/End of Session"
GOTO SUM
+3 USE IO(0)
SET DENTNCR=DENTNCR+1
if D=""
GOTO W1
SET D=$EXTRACT(D,2,75)
FOR I=1:1:74
IF "0123456789 "'[$EXTRACT(D,I)
GOTO W1
+4 IF +$EXTRACT(D,5,13)=2
SET DENT=1
SET E=0
DO NCT^DENTCRD2
KILL D,DENT,E
GOTO READCRD
+5 DO EN^DENTCRD1
IF '$DATA(D2)
SET DENTERR=DENTERR+1
KILL D
GOTO READCRD
+6 IF '$DATA(^DENT(221,0))
WRITE !!,"YOUR DENTAL TREATMENT FILE IS NOT SET UP PROPERLY",!,"CONTACT YOUR SITE MANAGER",*7
USE IO
XECUTE ^%ZIS("C")
GOTO EXIT
+7 SET N1=$PIECE(^DENT(221,0),"^",4)
SET N1=N1+1
SET N=$PIECE(D2,"^")
+8 ;file record and return IEN
DO SAVE(221,D2,.N)
+9 SET ^DENT(221,0)=$PIECE(^DENT(221,0),"^",1,2)_"^"_N_"^"_N1
SET DENTVAL=DENTVAL+1
+10 SET X=$PIECE(D2,"^",39)
if X=""!(X="GROUP")!('$DATA(D39))
GOTO Q
IF '$DATA(^DENT(220,0))
SET ^DENT(220,0)="DENTAL PATIENT^220P^^"
+11 IF '$DATA(^DENT(220,D39,0))
SET ^DENT(220,D39,0)=D39
SET ^DENT(220,"B",D39,D39)=""
SET ^DENT(220,0)=$PIECE(^DENT(220,0),"^",1,2)_"^"_D39_"^"_($PIECE(^DENT(220,0),"^",4)+1)
Q KILL D,D2,X,D39
GOTO READCRD
W WRITE !!,"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
GOTO EXIT
W1 WRITE !,"This card is unreadable -- Remove and correct card. Check for extraneous marks",*7
KILL D
SET DENTERR=DENTERR+1
GOTO READCRD
SUM WRITE !!,?5,"----- SESSION COMPLETE -----",!,?5,"Total Cards Read: ",DENTNCR
+1 WRITE !,?5,"Total Errors: ",DENTERR,!,?5,"Total Valid: ",DENTVAL
+2 if DENTERR
WRITE !,"**NOTE** Cards that had errors must be corrected and reread thru the card reader"
EXIT KILL D,D2,DENT,DENTERR,DENTNCR,DENTSTA,DENTVAL,DENTXX1,DENTY,DIC,DIR,E,I,IOP,N,N1,X,XX1,Y,Z,Z1,Z2,Z3,ZZ
QUIT
SAVE(FILE,VAR,REC) ; Stuff and index the dental record, return IEN
+1 NEW DIC,DIE,X,DA
+2 SET X=$PIECE(VAR,U,1)
+3 ;execute input transform which converts the date to a unique
+4 ;inverse date/time & returns DINUM
+5 XECUTE $PIECE(^DD(FILE,.01,0),U,5,99)
+6 SET DIC="^DENT("_FILE_","
SET DIC(0)="EZ"
SET DIC("DR")=""
DO FILE^DICN
SET REC=+Y
+7 SET ^DENT(FILE,REC,0)=VAR
SET DA=REC
SET DIK="^DENT("_FILE_","
DO IX^DIK
+8 QUIT
