- 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 Mar 13, 2025@20:50:46 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
