PSOARCF6.m

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

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