PSOARCF6 ;BHAM ISC/LGH,LC - WRITE PSRX INFO TO FILE ; 08/19/92
;;7.0;OUTPATIENT PHARMACY;;DEC 1997
EN ;
TAPE D PSOAT Q:$G(PSORWND)=0 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 W RX(RX0,2),!
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")) W "IB$$"_RX(RX0,"IB"),!
CNODE I $D(RX(RX0,"C")) W "C$$"_RX(RX0,"C"),!
DNODE I $D(RX(RX0,"D")) W "D$$"_RX(RX0,"D"),!
SNODE I $D(RX(RX0,"SAND")) W "S$$"_RX(RX0,"SAND"),!
K RX(RX0)
Q
;
;
PSOAT U PSOAT S:$$STATUS^%ZISH PSORWND=$$REWIND^%ZIS(PSOAIO,PSOAIOT,PSOAPAR) I $G(PSORWND)=0 U IO(0) W !!,"HFS file failed to rewind" Q
U PSOAT
Q
TAPE1 W 1_","_X_"$$"_RX(RX0,1,X,0),! Q
TAPE4 W 4_","_X_"$$"_RX(RX0,4,X,0),! Q
TAPE5 W 5_","_X_"$$"_RX(RX0,5,X,0),! Q
ANODE1 W "A"_","_X_"$$"_RX(RX0,"A",X,0),! Q
LNODE1 W "L"_","_X_"$$"_RX(RX0,"L",X,0),! Q
PNODE1 W "P"_","_X_"$$"_RX(RX0,"P",X,0),! Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOARCF6 1304 printed Dec 13, 2024@02:24:16 Page 2
PSOARCF6 ;BHAM ISC/LGH,LC - WRITE PSRX INFO TO FILE ; 08/19/92
+1 ;;7.0;OUTPATIENT PHARMACY;;DEC 1997
EN ;
TAPE DO PSOAT
if $GET(PSORWND)=0
QUIT
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 WRITE RX(RX0,2),!
+1 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"))
WRITE "IB$$"_RX(RX0,"IB"),!
CNODE IF $DATA(RX(RX0,"C"))
WRITE "C$$"_RX(RX0,"C"),!
DNODE IF $DATA(RX(RX0,"D"))
WRITE "D$$"_RX(RX0,"D"),!
SNODE IF $DATA(RX(RX0,"SAND"))
WRITE "S$$"_RX(RX0,"SAND"),!
+1 KILL RX(RX0)
+2 QUIT
+3 ;
+4 ;
PSOAT USE PSOAT
if $$STATUS^%ZISH
SET PSORWND=$$REWIND^%ZIS(PSOAIO,PSOAIOT,PSOAPAR)
IF $GET(PSORWND)=0
USE IO(0)
WRITE !!,"HFS file failed to rewind"
QUIT
+1 USE PSOAT
+2 QUIT
TAPE1 WRITE 1_","_X_"$$"_RX(RX0,1,X,0),!
QUIT
TAPE4 WRITE 4_","_X_"$$"_RX(RX0,4,X,0),!
QUIT
TAPE5 WRITE 5_","_X_"$$"_RX(RX0,5,X,0),!
QUIT
ANODE1 WRITE "A"_","_X_"$$"_RX(RX0,"A",X,0),!
QUIT
LNODE1 WRITE "L"_","_X_"$$"_RX(RX0,"L",X,0),!
QUIT
PNODE1 WRITE "P"_","_X_"$$"_RX(RX0,"P",X,0),!
QUIT
