PSOARCTP ;BHAM ISC/LGH - WRITE PSRX INFO TO TAPE ; 08/19/92
;;7.0;OUTPATIENT PHARMACY;;DEC 1997
EN ;
TAPE D PSOAT D:PSOAEOT TAPE1^PSOARCS2 G:PSOAEOT TAPE W RX(RX0,0)
I $D(RX(RX0,1,0)) D
.F X=0:0 S X=$O(RX(RX0,1,X)) Q:'X I $G(RX(RX0,1,X,0))]"" D TAPE1
I $D(RX(RX0,4,0)) D
.F X=0:0 S X=$O(RX(RX0,4,X)) Q:'X I $G(RX(RX0,4,X,0))]"" D TAPE4
I $D(RX(RX0,5,0)) D
.F X=0:0 S X=$O(RX(RX0,5,X)) Q:'X I $G(RX(RX0,5,X,0))]"" D TAPE5
TAPE2 D PSOAT D:PSOAEOT TAPE1^PSOARCS2 G:PSOAEOT TAPE W RX(RX0,2)
D PSOAT D:PSOAEOT TAPE1^PSOARCS2 G:PSOAEOT TAPE W RX(RX0,3)
ANODE I $D(RX(RX0,"A",0)) F X=0:0 S X=$O(RX(RX0,"A",X)) Q:'X D ANODE1
LNODE I $D(RX(RX0,"L",0)) F X=0:0 S X=$O(RX(RX0,"L",X)) Q:'X D LNODE1
PNODE I $D(RX(RX0,"P",0)) F X=0:0 S X=$O(RX(RX0,"P",X)) Q:'X D PNODE1
IBNODE I $D(RX(RX0,"IB")) D PSOAT D:PSOAEOT TAPE1^PSOARCS2 G:PSOAEOT TAPE W "IB$$"_RX(RX0,"IB")
CNODE I $D(RX(RX0,"C")) D PSOAT D:PSOAEOT TAPE1^PSOARCS2 G:PSOAEOT TAPE W "C$$"_RX(RX0,"C")
DNODE I $D(RX(RX0,"D")) D PSOAT D:PSOAEOT TAPE1^PSOARCS2 G:PSOAEOT TAPE W "D$$"_RX(RX0,"D")
SNODE I $D(RX(RX0,"SAND")) D PSOAT D:PSOAEOT TAPE1^PSOARCS2 G:PSOAEOT TAPE W "S$$"_RX(RX0,"SAND")
K RX(RX0)
Q
;
;
PSOAT U PSOAT S (PSRST,PSOAEOT)=0 X ^%ZOSF("EOT") I Y D EOT1 S PSOAEOT=1
U PSOAT Q
EOT1 U IO(0) W !!,?5,"** End of tape detected **",!,"After current tape rewinds, mount next tape" U PSOAT W @%MT("REW")
READ U IO(0) R !,?5,"Press RETURN to continue",X:DTIME I '$T G READ
W !!,"Recording information" S PSOATNM=PSOATNM+1
Q
TAPE1 D PSOAT D:PSOAEOT TAPE1^PSOARCS2 G:PSOAEOT TAPE W 1_","_X_"$$"_RX(RX0,1,X,0) Q
TAPE4 D PSOAT D:PSOAEOT TAPE1^PSOARCS2 G:PSOAEOT TAPE W 4_","_X_"$$"_RX(RX0,4,X,0) Q
TAPE5 D PSOAT D:PSOAEOT TAPE1^PSOARCS2 G:PSOAEOT TAPE W 5_","_X_"$$"_RX(RX0,5,X,0) Q
ANODE1 D PSOAT D:PSOAEOT TAPE1^PSOARCS2 G:PSOAEOT TAPE W "A"_","_X_"$$"_RX(RX0,"A",X,0) Q
LNODE1 D PSOAT D:PSOAEOT TAPE1^PSOARCS2 G:PSOAEOT TAPE W "L"_","_X_"$$"_RX(RX0,"L",X,0) Q
PNODE1 D PSOAT D:PSOAEOT TAPE1^PSOARCS2 G:PSOAEOT TAPE W "P"_","_X_"$$"_RX(RX0,"P",X,0) Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOARCTP 2055 printed Sep 23, 2025@20:00:38 Page 2
PSOARCTP ;BHAM ISC/LGH - WRITE PSRX INFO TO TAPE ; 08/19/92
+1 ;;7.0;OUTPATIENT PHARMACY;;DEC 1997
EN ;
TAPE DO PSOAT
if PSOAEOT
DO TAPE1^PSOARCS2
if PSOAEOT
GOTO TAPE
WRITE RX(RX0,0)
+1 IF $DATA(RX(RX0,1,0))
Begin DoDot:1
+2 FOR X=0:0
SET X=$ORDER(RX(RX0,1,X))
if 'X
QUIT
IF $GET(RX(RX0,1,X,0))]""
DO TAPE1
End DoDot:1
+3 IF $DATA(RX(RX0,4,0))
Begin DoDot:1
+4 FOR X=0:0
SET X=$ORDER(RX(RX0,4,X))
if 'X
QUIT
IF $GET(RX(RX0,4,X,0))]""
DO TAPE4
End DoDot:1
+5 IF $DATA(RX(RX0,5,0))
Begin DoDot:1
+6 FOR X=0:0
SET X=$ORDER(RX(RX0,5,X))
if 'X
QUIT
IF $GET(RX(RX0,5,X,0))]""
DO TAPE5
End DoDot:1
TAPE2 DO PSOAT
if PSOAEOT
DO TAPE1^PSOARCS2
if PSOAEOT
GOTO TAPE
WRITE RX(RX0,2)
+1 DO PSOAT
if PSOAEOT
DO TAPE1^PSOARCS2
if PSOAEOT
GOTO TAPE
WRITE RX(RX0,3)
ANODE IF $DATA(RX(RX0,"A",0))
FOR X=0:0
SET X=$ORDER(RX(RX0,"A",X))
if 'X
QUIT
DO ANODE1
LNODE IF $DATA(RX(RX0,"L",0))
FOR X=0:0
SET X=$ORDER(RX(RX0,"L",X))
if 'X
QUIT
DO LNODE1
PNODE IF $DATA(RX(RX0,"P",0))
FOR X=0:0
SET X=$ORDER(RX(RX0,"P",X))
if 'X
QUIT
DO PNODE1
IBNODE IF $DATA(RX(RX0,"IB"))
DO PSOAT
if PSOAEOT
DO TAPE1^PSOARCS2
if PSOAEOT
GOTO TAPE
WRITE "IB$$"_RX(RX0,"IB")
CNODE IF $DATA(RX(RX0,"C"))
DO PSOAT
if PSOAEOT
DO TAPE1^PSOARCS2
if PSOAEOT
GOTO TAPE
WRITE "C$$"_RX(RX0,"C")
DNODE IF $DATA(RX(RX0,"D"))
DO PSOAT
if PSOAEOT
DO TAPE1^PSOARCS2
if PSOAEOT
GOTO TAPE
WRITE "D$$"_RX(RX0,"D")
SNODE IF $DATA(RX(RX0,"SAND"))
DO PSOAT
if PSOAEOT
DO TAPE1^PSOARCS2
if PSOAEOT
GOTO TAPE
WRITE "S$$"_RX(RX0,"SAND")
+1 KILL RX(RX0)
+2 QUIT
+3 ;
+4 ;
PSOAT USE PSOAT
SET (PSRST,PSOAEOT)=0
XECUTE ^%ZOSF("EOT")
IF Y
DO EOT1
SET PSOAEOT=1
+1 USE PSOAT
QUIT
EOT1 USE IO(0)
WRITE !!,?5,"** End of tape detected **",!,"After current tape rewinds, mount next tape"
USE PSOAT
WRITE @%MT("REW")
READ USE IO(0)
READ !,?5,"Press RETURN to continue",X:DTIME
IF '$TEST
GOTO READ
+1 WRITE !!,"Recording information"
SET PSOATNM=PSOATNM+1
+2 QUIT
TAPE1 DO PSOAT
if PSOAEOT
DO TAPE1^PSOARCS2
if PSOAEOT
GOTO TAPE
WRITE 1_","_X_"$$"_RX(RX0,1,X,0)
QUIT
TAPE4 DO PSOAT
if PSOAEOT
DO TAPE1^PSOARCS2
if PSOAEOT
GOTO TAPE
WRITE 4_","_X_"$$"_RX(RX0,4,X,0)
QUIT
TAPE5 DO PSOAT
if PSOAEOT
DO TAPE1^PSOARCS2
if PSOAEOT
GOTO TAPE
WRITE 5_","_X_"$$"_RX(RX0,5,X,0)
QUIT
ANODE1 DO PSOAT
if PSOAEOT
DO TAPE1^PSOARCS2
if PSOAEOT
GOTO TAPE
WRITE "A"_","_X_"$$"_RX(RX0,"A",X,0)
QUIT
LNODE1 DO PSOAT
if PSOAEOT
DO TAPE1^PSOARCS2
if PSOAEOT
GOTO TAPE
WRITE "L"_","_X_"$$"_RX(RX0,"L",X,0)
QUIT
PNODE1 DO PSOAT
if PSOAEOT
DO TAPE1^PSOARCS2
if PSOAEOT
GOTO TAPE
WRITE "P"_","_X_"$$"_RX(RX0,"P",X,0)
QUIT
