source: WorldVistAEHR/trunk/r/DENTAL-DEN/DENTAT.m@ 776

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

initial load of WorldVistAEHR

File size: 1.5 KB
RevLine 
[613]1DENTAT ;ISC2/SAW-CREATE DENTAL SERVICE TAPE ; 7/21/88 5:42 PM ;
2 ;;VERSION 1.2
3 W !,*7,"This option will create the Dental Service Magnetic Tape",!,"Which must be sent to the Austin TX DPC"
4 R !,"Are you sure you want to continue? N// ",X:DTIME S:X=""!(X["^") X="N" G:X["N" EXIT
5 I '$D(^UTILITY("DENTV")) W !!,"There is no data in the Dental Service Tape global??? Can't write a tape without data.",*7 G EXIT
6OPEN R !,"Press the return key when Magtape device is ready: ",X:DTIME G EXIT:'$T,EXIT:X="^",OPEN:X'=""
7 S IOP="AMIS TAPE" D ^%ZIS U IO I POP U IO(0) W !,*7,"Unable to open Magtape device" G OPEN
8 S DENTI=^DD("OS"),DENTOS=$S($D(^DD("OS",DENTI,0)):$P(^(0),"^",1),1:"") I DENTOS']"" G OSERR
9 S DENTTP=$S(DENTOS["DSM":2,DENTOS["M/11+":1,DENTOS["M/11":2,1:0) I 'DENTTP G OSERR
10 U IO S DENTTP1=$S(DENTTP=1:"*-5,*-8",DENTTP=2:"*5,*8",1:"") W @DENTTP1
11 S N="",J1=^UTILITY("DENTV") F I=1:1:J1 S N=$O(^UTILITY("DENTV",N)) Q:N="" W $E(^(N,0),1,80)
12 D FILL S DENTTP1=$S(DENTTP=1:"*-4,*-9,*-5",DENTTP=2:"*4,*9,*5",1:"") W @DENTTP1
13 X ^%ZIS("C") U IO(0) W !,J1," Records were written to tape."
14EXIT K I,IOP,J1,N,N1,X,DENTTP,DENTTP1,DENTOS,DENTI Q
15FILL Q:'((I-1)#10) S DENTFILL=((I-1)#10)+1,DENTJ="" F J=1:1:80 S DENTJ=DENTJ_"X"
16 F J=DENTFILL:1:10 W $E(DENTJ,1,80)
17 K DENTJ,J,DENTFILL Q
18OSERR X ^%ZIS("C") U IO(0) W !,*7 F I=0:1:79 W "*"
19 W !,"This routine is not designed to run on your present operating system.",!," Contact your regional ISC for information on how to continue.",!!!," PLEASE NOTE: NO DATA HAS BEEN OUTPUT TO THIS TAPE!!!"
20 W ! F I=0:1:79 W "*"
21 Q
Note: See TracBrowser for help on using the repository browser.