AZP3EDT.m

AZP3EDT ;EDIT INSURANCE DATA [ 10/01/90  3:46 PM ]

 ;FCJ PAO 10/1/90

VAR S U="^",RXDSP=$P(^AZPPI(0,DUZ(2),1),U,2)

 S DIC="^AZPPI(1,",DIC(0)="MEZA",DIC("A")="Enter Bill Number: ",DR="[AZP3ED]",DIE="^AZPPI(1," 

A1 D ^DIC G:Y<0 EXIT S DA=$P(Y,U) D ^DIE

RX S RXTOT=0 G:'$D(^AZPPI(1,DA,3)) CPT 

RX1 S ND=0  F  S ND=$O(^AZPPI(1,DA,3,ND)) Q:ND'?1N.N  S PRX=$P(^(ND,0),U) D

 .S PRX1=0,RXDATA=^PSRX(PRX,0),PDRG=$P(RXDATA,U,6),RXDT=$P(^PSRX(PRX,3),U),RXQTY=$P(RXDATA,U,7)

 .I $D(^PSRX(1,PRX,"B",RXDT)) S PRX1=$O(^PSRX(1,PRX,"B",RXDT,PRX1)),RXDATA1=^PSRX(PRX,1,PRX1,0),RXQTY=$P(RXDATA1,U,4)

 .S DRGCST=$S($D(^PSDRUG(PDRG,660)):$P(^(660),U,6),1:0),RXCST=RXQTY*DRGCST,RXCST=RXDSP+RXCST,RXTOT=RXCST+RXTOT

CPT S (PDOS,TOT)=0 F  S PDOS=$O(^AZPPI(1,DA,4,PDOS)) Q:PDOS'?1N.N  S PCPT=0 D

 .F  S PCPT=$O(^AZPPI(1,DA,4,PDOS,1,PCPT)) Q:PCPT'?1N.N  D

 ..S DATA=^(PCPT,0),DATA1=$P(DATA,U),DATA1=^AZPPI(2,DATA1,0)

 ..S TOT=$P(DATA1,U,3)+TOT

 S $P(^AZPPI(1,DA,5),U)=TOT+RXTOT,$P(^AZPPI(1,DA,1),U,9)=RXTOT W !! G A1

EXIT K RXDSP,DIC,DIC(0),DIC("A"),DA,DR,DIE,YR,ND,RX,RXCST,RXDPS,RXTOT,TOT,U,PRX,PRX1,RXDATA,PDRG,RXDT,RXQTY,RXDATA1,DRGCST,PDOS,PCPT,DATA,DATA1 Q

AZP3EDT   ;EDIT INSURANCE DATA [ 10/01/90  3:46 PM ]

 +1       ;FCJ PAO 10/1/90

VAR        SET U="^"

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

 +1        SET DIC="^AZPPI(1,"

           SET DIC(0)="MEZA"

           SET DIC("A")="Enter Bill Number: "

           SET DR="[AZP3ED]"

           SET DIE="^AZPPI(1,"

A1         DO ^DIC

           IF Y<0

               GOTO EXIT

           SET DA=$PIECE(Y,U)

           DO ^DIE

RX         SET RXTOT=0

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

               GOTO CPT

RX1        SET ND=0

           FOR 

               SET ND=$ORDER(^AZPPI(1,DA,3,ND))

               IF ND'?1N.N

                   QUIT 

               SET PRX=$PIECE(^(ND,0),U)

               Begin DoDot:1

 +1                SET PRX1=0

                   SET RXDATA=^PSRX(PRX,0)

                   SET PDRG=$PIECE(RXDATA,U,6)

                   SET RXDT=$PIECE(^PSRX(PRX,3),U)

                   SET RXQTY=$PIECE(RXDATA,U,7)

 +2                IF $DATA(^PSRX(1,PRX,"B",RXDT))

                       SET PRX1=$ORDER(^PSRX(1,PRX,"B",RXDT,PRX1))

                       SET RXDATA1=^PSRX(PRX,1,PRX1,0)

                       SET RXQTY=$PIECE(RXDATA1,U,4)

 +3                SET DRGCST=$SELECT($DATA(^PSDRUG(PDRG,660)):$PIECE(^(660),U,6),1:0)

                   SET RXCST=RXQTY*DRGCST

                   SET RXCST=RXDSP+RXCST

                   SET RXTOT=RXCST+RXTOT

               End DoDot:1

CPT        SET (PDOS,TOT)=0

           FOR 

               SET PDOS=$ORDER(^AZPPI(1,DA,4,PDOS))

               IF PDOS'?1N.N

                   QUIT 

               SET PCPT=0

               Begin DoDot:1

 +1                FOR 

                       SET PCPT=$ORDER(^AZPPI(1,DA,4,PDOS,1,PCPT))

                       IF PCPT'?1N.N

                           QUIT 

                       Begin DoDot:2

 +2                        SET DATA=^(PCPT,0)

                           SET DATA1=$PIECE(DATA,U)

                           SET DATA1=^AZPPI(2,DATA1,0)

 +3                        SET TOT=$PIECE(DATA1,U,3)+TOT

                       End DoDot:2

               End DoDot:1

 +4        SET $PIECE(^AZPPI(1,DA,5),U)=TOT+RXTOT

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

           WRITE !!

           GOTO A1

EXIT       KILL RXDSP,DIC,DIC(0),DIC("A"),DA,DR,DIE,YR,ND,RX,RXCST,RXDPS,RXTOT,TOT,U,PRX,PRX1,RXDATA,PDRG,RXDT,RXQTY,RXDATA1,DRGCST,PDOS,PCPT,DATA,DATA1

           QUIT