DENTAT.m

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 ---DENTAT   1589     printed  Apr 09, 2024@20:51:35                                                                                                                                                                                                      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