DENTAT ;ISC2/SAW-CREATE DENTAL SERVICE TAPE ; 7/21/88 5:42 PM ;
;;VERSION 1.2
W !,*7,"This option will create the Dental Service Magnetic Tape",!,"Which must be sent to the Austin TX DPC"
R !,"Are you sure you want to continue? N// ",X:DTIME S:X=""!(X["^") X="N" G:X["N" EXIT
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
OPEN R !,"Press the return key when Magtape device is ready: ",X:DTIME G EXIT:'$T,EXIT:X="^",OPEN:X'=""
S IOP="AMIS TAPE" D ^%ZIS U IO I POP U IO(0) W !,*7,"Unable to open Magtape device" G OPEN
S DENTI=^DD("OS"),DENTOS=$S($D(^DD("OS",DENTI,0)):$P(^(0),"^",1),1:"") I DENTOS']"" G OSERR
S DENTTP=$S(DENTOS["DSM":2,DENTOS["M/11+":1,DENTOS["M/11":2,1:0) I 'DENTTP G OSERR
U IO S DENTTP1=$S(DENTTP=1:"*-5,*-8",DENTTP=2:"*5,*8",1:"") W @DENTTP1
S N="",J1=^UTILITY("DENTV") F I=1:1:J1 S N=$O(^UTILITY("DENTV",N)) Q:N="" W $E(^(N,0),1,80)
D FILL S DENTTP1=$S(DENTTP=1:"*-4,*-9,*-5",DENTTP=2:"*4,*9,*5",1:"") W @DENTTP1
X ^%ZIS("C") U IO(0) W !,J1," Records were written to tape."
EXIT K I,IOP,J1,N,N1,X,DENTTP,DENTTP1,DENTOS,DENTI Q
FILL Q:'((I-1)#10) S DENTFILL=((I-1)#10)+1,DENTJ="" F J=1:1:80 S DENTJ=DENTJ_"X"
F J=DENTFILL:1:10 W $E(DENTJ,1,80)
K DENTJ,J,DENTFILL Q
OSERR X ^%ZIS("C") U IO(0) W !,*7 F I=0:1:79 W "*"
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!!!"
W ! F I=0:1:79 W "*"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDENTAT 1589 printed Dec 13, 2024@01:46:05 Page 2
DENTAT ;ISC2/SAW-CREATE DENTAL SERVICE TAPE ; 7/21/88 5:42 PM ;
+1 ;;VERSION 1.2
+2 WRITE !,*7,"This option will create the Dental Service Magnetic Tape",!,"Which must be sent to the Austin TX DPC"
+3 READ !,"Are you sure you want to continue? N// ",X:DTIME
if X=""!(X["^")
SET X="N"
if X["N"
GOTO EXIT
+4 IF '$DATA(^UTILITY("DENTV"))
WRITE !!,"There is no data in the Dental Service Tape global??? Can't write a tape without data.",*7
GOTO EXIT
OPEN READ !,"Press the return key when Magtape device is ready: ",X:DTIME
if '$TEST
GOTO EXIT
if X="^"
GOTO EXIT
if X'=""
GOTO OPEN
+1 SET IOP="AMIS TAPE"
DO ^%ZIS
USE IO
IF POP
USE IO(0)
WRITE !,*7,"Unable to open Magtape device"
GOTO OPEN
+2 SET DENTI=^DD("OS")
SET DENTOS=$SELECT($DATA(^DD("OS",DENTI,0)):$PIECE(^(0),"^",1),1:"")
IF DENTOS']""
GOTO OSERR
+3 SET DENTTP=$SELECT(DENTOS["DSM":2,DENTOS["M/11+":1,DENTOS["M/11":2,1:0)
IF 'DENTTP
GOTO OSERR
+4 USE IO
SET DENTTP1=$SELECT(DENTTP=1:"*-5,*-8",DENTTP=2:"*5,*8",1:"")
WRITE @DENTTP1
+5 SET N=""
SET J1=^UTILITY("DENTV")
FOR I=1:1:J1
SET N=$ORDER(^UTILITY("DENTV",N))
if N=""
QUIT
WRITE $EXTRACT(^(N,0),1,80)
+6 DO FILL
SET DENTTP1=$SELECT(DENTTP=1:"*-4,*-9,*-5",DENTTP=2:"*4,*9,*5",1:"")
WRITE @DENTTP1
+7 XECUTE ^%ZIS("C")
USE IO(0)
WRITE !,J1," Records were written to tape."
EXIT KILL I,IOP,J1,N,N1,X,DENTTP,DENTTP1,DENTOS,DENTI
QUIT
FILL if '((I-1)#10)
QUIT
SET DENTFILL=((I-1)#10)+1
SET DENTJ=""
FOR J=1:1:80
SET DENTJ=DENTJ_"X"
+1 FOR J=DENTFILL:1:10
WRITE $EXTRACT(DENTJ,1,80)
+2 KILL DENTJ,J,DENTFILL
QUIT
OSERR XECUTE ^%ZIS("C")
USE IO(0)
WRITE !,*7
FOR I=0:1:79
WRITE "*"
+1 WRITE !,"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!!!"
+2 WRITE !
FOR I=0:1:79
WRITE "*"
+3 QUIT
