AZP3RX.m

AZP3RX ;Print RX information for private insurance [ 01/24/91  4:01 PM ]

 ;FCJ PAO 09/04/90

VAR S RX="Y" D ^AZP3UTL G:RX="" EXIT 

B ;SET PRINT VARIABLES

 S DOCNO=($E(BDOC,5,8)-1)+10000,DOCNO=$E(DOCNO,2,5),BDOC=$E(BDOC,1,4)_DOCNO

 F  S BDOC=$O(^AZPPI(1,"B",BDOC)) S BTSTDOC=$E(BDOC,1,2)_$E(BDOC,5,8) G:(BTSTDOC>ETSTDOC)!(BDOC="") EXIT S ND=0 D

 .F  S ND=$O(^AZPPI(1,"B",BDOC,ND)) Q:ND=""  S DATA=^AZPPI(1,ND,0),DATA1=^(1),DUZ(2)=$P(DATA,U,9),DFN=$P(DATA,U,2) D B1

EXIT D KLL2^AZP3UTL Q

B1 ;PATIENT DEMOGRAPHIC DATA

 Q:'$D(^AZPPI(1,ND,3))  S RXTOT1=0,TOT=0,RXTOT=0

 S DATA2=^DPT(DFN,0),NM=$P(DATA2,U,1),HRN=$P(^AUPNPAT(DFN,41,DUZ(2),0),U,2)

 S DATA2=^DPT(DFN,.11),STR=$P(DATA2,U,1),CTY=$P(DATA2,U,4),ZIP=$P(DATA2,U,6),ST=$P(DATA2,U,5),ST=$P(^DIC(5,ST,0),U)

C U IO W @IOF,!!,"Claim Number:  ",BDOC,!!,?5,"Patient's Name:  ",?30,NM,!?5,"Health Record No.:",?30,HRN,!?5,"Address:  ",?30,STR,!?30,CTY,"  ",ST,"  ",ZIP,!!

RX S RXDSP=$P(^AZPPI(0,DUZ(2),1),U,2),ND2=ND Q:'$D(^AZPPI(1,ND2,3))  W ! F L=1:1:80 W "-"

 D RX1^AZP3ENT

 S RXTOT1=$P(^AZPPI(1,ND2,1),U,9) I RXTOT1'=RXTOT S TOT=RXTOT-RXTOT1,$P(^(1),U,9)=RXTOT,$P(^(5),U)=$P(^(5),U)+TOT Q

AZP3RX    ;Print RX information for private insurance [ 01/24/91  4:01 PM ]

 +1       ;FCJ PAO 09/04/90

VAR        SET RX="Y"

           DO ^AZP3UTL

           IF RX=""

               GOTO EXIT

B         ;SET PRINT VARIABLES

 +1        SET DOCNO=($EXTRACT(BDOC,5,8)-1)+10000

           SET DOCNO=$EXTRACT(DOCNO,2,5)

           SET BDOC=$EXTRACT(BDOC,1,4)_DOCNO

 +2        FOR 

               SET BDOC=$ORDER(^AZPPI(1,"B",BDOC))

               SET BTSTDOC=$EXTRACT(BDOC,1,2)_$EXTRACT(BDOC,5,8)

               IF (BTSTDOC>ETSTDOC)!(BDOC="")

                   GOTO EXIT

               SET ND=0

               Begin DoDot:1

 +3                FOR 

                       SET ND=$ORDER(^AZPPI(1,"B",BDOC,ND))

                       IF ND=""

                           QUIT 

                       SET DATA=^AZPPI(1,ND,0)

                       SET DATA1=^(1)

                       SET DUZ(2)=$PIECE(DATA,U,9)

                       SET DFN=$PIECE(DATA,U,2)

                       DO B1

               End DoDot:1

EXIT       DO KLL2^AZP3UTL

           QUIT 

B1        ;PATIENT DEMOGRAPHIC DATA

 +1        IF '$DATA(^AZPPI(1,ND,3))

               QUIT 

           SET RXTOT1=0

           SET TOT=0

           SET RXTOT=0

 +2        SET DATA2=^DPT(DFN,0)

           SET NM=$PIECE(DATA2,U,1)

           SET HRN=$PIECE(^AUPNPAT(DFN,41,DUZ(2),0),U,2)

 +3        SET DATA2=^DPT(DFN,.11)

           SET STR=$PIECE(DATA2,U,1)

           SET CTY=$PIECE(DATA2,U,4)

           SET ZIP=$PIECE(DATA2,U,6)

           SET ST=$PIECE(DATA2,U,5)

           SET ST=$PIECE(^DIC(5,ST,0),U)

C          USE IO

           WRITE @IOF,!!,"Claim Number:  ",BDOC,!!,?5,"Patient's Name:  ",?30,NM,!?5,"Health Record No.:",?30,HRN,!?5,"Address:  ",?30,STR,!?30,CTY,"  ",ST,"  ",ZIP,!!

RX         SET RXDSP=$PIECE(^AZPPI(0,DUZ(2),1),U,2)

           SET ND2=ND

           IF '$DATA(^AZPPI(1,ND2,3))

               QUIT 

           WRITE !

           FOR L=1:1:80

               WRITE "-"

 +1        DO RX1^AZP3ENT

 +2        SET RXTOT1=$PIECE(^AZPPI(1,ND2,1),U,9)

           IF RXTOT1'=RXTOT

               SET TOT=RXTOT-RXTOT1

               SET $PIECE(^(1),U,9)=RXTOT

               SET $PIECE(^(5),U)=$PIECE(^(5),U)+TOT

               QUIT