- 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 Feb 18, 2025@23:50:51 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