ABMDVST5 ; IHS/ASDST/DMJ - PCC VISIT STUFF - PART 6 (PHARMACY) ;
;;2.6;IHS Third Party Billing System;**2,4**;NOV 12, 2009
;Original;TMD;08/19/96 5:01 PM
;
; IHS/SD/SDR - v2.5 p8 - task 57
; Removed check for OTC drugs and no entry in fee schedule. Also
; added code to populate dt disc. and RTS if flag is set.
; IHS/SD/SDR - v2.5 p9 - IM19140 - <SUBSCRIPT>ABMDVST5+29^ABMDVST5
; IHS/SD/SDR - v2.5 p10 - IM21500 - Added code to check new V Med field
; POINT OF SALE BILLING STATUS and only bill if blank or rejected
;
I $G(ABMP("RXDONE")) Q
I $G(ABMP("INS"))'="",($P($G(^AUTNINS(ABMP("INS"),2)),U,3)="U") Q
I $G(ABMP("INS"))'="",($P($G(^AUTNINS(ABMP("INS"),2)),"^",3)="P") Q
S (ABM("TIME"),ABMR("TIME"))=$P(ABMP("V0"),U)
;
MED ;
K DIC
S DA(1)=ABMP("CDFN"),DIC="^ABMDCLM(DUZ(2),"_DA(1)_",23,",DIC(0)="LE"
S ABM=0 F S ABM=$O(^AUPNVMED("AD",ABMVDFN,ABM)) Q:'ABM D
.Q:'$D(^AUPNVMED(ABM,0))
.Q:$P(^AUPNVMED(ABM,0),"^",8)&($G(ABMRXFLG)'=1)
.S X=$P(^AUPNVMED(ABM,0),U)
.S ABMSRC="14|"_ABM_"|RX"
.D MEDCHK
.Q:ABMR("QTY")=""&($G(ABMRXFLG)'=1)
.Q:$G(ABMR("RTS"))&($G(ABMRXFLG)'=1)
.D MEDSET
Q K DIC,ABMR,DR,DIE,X,Y
Q
;
MEDCHK ;
S ABMR("X")=$O(^PSRX("APCC",ABM,""))
I ABMR("X")="" D NORX Q
S ABMR("RX")=$P($G(^PSRX(ABMR("X"),0)),U)
I ABMR("RX")="" D NORX Q
S ABMR("DTWR")=$P(^PSRX(ABMR("X"),0),"^",13)
S ABMR("REF")=$O(^PSRX("APCC",ABM,ABMR("X"),0))
I ABMR("REF")="" D
.S ABMR0=$G(^PSRX(ABMR("X"),0))
.S ABMR2=$G(^PSRX(ABMR("X"),2))
.S ABMR("QTY")=$P(ABMR0,"^",7)
.S ABMR("RTS")=$P(ABMR2,"^",15)
.S ABMR("DAYS")=$P(ABMR0,"^",8)
.S ABMR("NDC")=$P(ABMR2,"^",7)
.S ABMR("PROV")=$P(ABMR0,"^",4)
I ABMR("REF")'="" D
.S ABMR0=$G(^PSRX(ABMR("X"),1,ABMR("REF"),0))
.S ABMR("QTY")=$P(ABMR0,"^",4)
.S ABMR("RTS")=$P(ABMR0,"^",16)
.S ABMR("DAYS")=$P(ABMR0,"^",10)
.S ABMR("NDC")=$$NDCVAL^ABMPFUNC(ABMR("X"),ABMR("REF"))
.S ABMR("PROV")=$P(ABMR0,"^",17)
Q
NORX ;no entry in prescription file
S ABMR("QTY")=$P(^AUPNVMED(ABM,0),"^",6)
S ABMR("RX")=""
Q
MEDSET ;FILE
S DA=$O(^ABMDCLM(DUZ(2),DA(1),"ASRC",ABMSRC,0))
I DA,'$D(@(DIC_DA_",0)")) S DA="" ;For duplicates problem
S ABMR("PPDU")=+$P($$ONE^ABMFEAPI(ABMP("FEE"),25,X,ABMP("VDT")),U) ;abm*2.6*2 3PMS10003A ;abm*2.6*4 NOHEAT
S:'ABMR("PPDU") ABMR("PPDU")=+$P($G(^PSDRUG(X,660)),U,6) ;abm*2.6*4 NOHEAT
I (($P($$ONE^ABMFEAPI(ABMP("FEE"),25,X,ABMP("VDT")),U)=0)&('ABMR("PPDU"))&($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,14)'="Y")) Q ;abm*2.6*4 NOHEAT
I 'DA D
.S DIC("P")=$P(^DD(9002274.3,23,0),U,2)
.; ADD DEFAULT REV CODE
.S DIC("DR")=".02////250"
.K DD,DO D FILE^DICN
.K DIC("DR")
.S DA=+Y
Q:DA<0 S DIE=DIC
S ABMR("SURC")=$S(ABMP("VTYP")'=111:$P(^ABMDPARM(DUZ(2),1,0),U,3),1:$P($G(^ABMDPARM(DUZ(2),1,4)),U,6))
;X is the drug ien. ABMDFEE is dinumed in this mult
;Q:($P($G(^ABMDFEE(ABMP("FEE"),25,X,0)),U,2)=0&($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,14)'="Y")) ;abm*2.6*2 3PMS10003A
;Q:($P($$ONE^ABMFEAPI(ABMP("FEE"),25,X,ABMP("VDT")),U)=0&($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,14)'="Y")) ;abm*2.6*2 3PMS10003A ;abm*2.6*4 NOHEAT
;S ABMR("PPDU")=+$P($G(^ABMDFEE(ABMP("FEE"),25,X,0)),U,2) ;abm*2.6*2 3PMS10003A
;S ABMR("PPDU")=+$P($$ONE^ABMFEAPI(ABMP("FEE"),25,X,ABMP("VDT")),U) ;abm*2.6*2 3PMS10003A ;abm*2.6*4 NOHEAT
;S:'ABMR("PPDU") ABMR("PPDU")=+$P($G(^PSDRUG(X,660)),U,6) ;abm*2.6*4 NOHEAT
K DR
S DR=".03////"_ABMR("QTY")_";.04////"_ABMR("PPDU")_";.05////"_ABMR("SURC")_";.06////"_ABMR("RX")_";.14////"_ABMR("TIME")
;Next line set correspond diagnosis if only 1 POV
I $D(ABMP("CORRSDIAG")) S DR=DR_";.13////1"
S DR=DR_";.17////"_ABMSRC
D ^DIE
S DR=".22////"_ABMR("X")
D ^DIE
S DR=".23////"_$G(ABMR("PROV"))
D ^DIE
S DR=".24////"_$G(ABMR("NDC"))
D ^DIE
S DR=".2////"_$G(ABMR("DAYS"))
D ^DIE
S DR=".19////"_+$G(ABMR("REF"))
D ^DIE
S DR=".25////"_$G(ABMR("DTWR"))
D ^DIE
S ABMP("RXDONE")=1
I $G(ABMRXFLG)=1 D
.S DR=".26////"_$P($G(^AUPNVMED(ABM,0)),U,8)
.S DR=DR_";.27////"_$G(ABMR("RTS"))
.D ^DIE
Q
;
MED3 ;EP
; 4/26/01 - This code is no longer called... leaving in routine for
; version just in case...
Q:$P($G(^AUTNINS(ABMP("INS"),2)),U,3)="U"
Q:$D(ABMP("MEDSCHKD"))
S DA(1)=ABMP("CDFN"),DIC="^ABMDCLM(DUZ(2),"_DA(1)_",23,",DIC(0)="LE"
S ABM("D")=ABMCHVDT-1
;ABM("ED") is the discharge date if it exists
S ABM("ED")=$S($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),6)),U,3):$P(^(6),U,3),1:ABMCHVDT)+.24
F S ABM("D")=$O(^PSRX("AD",ABM("D"))) Q:'ABM("D")!(ABM("D")>ABM("ED")) D
.S ABM("X")=0 F S ABM("X")=$O(^PSRX("AD",ABM("D"),ABM("X"))) Q:'ABM("X") I $P($G(^PSRX(ABM("X"),0)),U,2)=ABMP("PDFN") D MED3CK
K DIC
Q
;
MED3CK I $D(^PSRX("AD",ABM("D"),ABM("X")))=11 S ABM("REF")=$O(^PSRX("AD",ABM("D"),ABM("X"),""))
E S ABM("REF")=""
S X=$P(^PSRX(ABM("X"),0),U,6),ABM("RX")=$P(^(0),U),ABM("QTY")=$S('+ABM("REF"):$P(^(0),U,7),1:$P($G(^(1,ABM("REF"),0)),U,4))
S ABMSRC="PSRX|"_ABM("X")_"|RX"
Q:ABM("QTY")=""
Q:'$D(^PSDRUG(X,0))
Q:$P(^PSDRUG(X,0),"^",3)[9 ;OTC DRUG
S DA=$O(^ABMDCLM(DUZ(2),DA(1),"ASRC",ABMSRC,0))
I DA,'$D(@(DIC_DA_",0)")) S DA="" ;For duplicates problem
I 'DA D
.S ABMP("MEDSCHKD")=1
.S DIC("P")=$P(^DD(9002274.3,23,0),U,2)
.S DIC("DR")=".02////250"
.K DD,DO D FILE^DICN
.K DIC("DR")
.S DA=+Y
Q:DA<0 S DIE=DIC
S ABM("SURC")=$S(ABMP("VTYP")'=111:+$P(^ABMDPARM(DUZ(2),1,0),U,3),1:+$P($G(^ABMDPARM(DUZ(2),1,4)),"^",6))
;Q:($P($G(^ABMDFEE(ABMP("FEE"),25,X,0)),U,2)&($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,14)'="Y")) ;abm*2.6*2 3PMS10003A
Q:($P($$ONE^ABMFEAPI(ABMP("FEE"),25,X,ABMP("VDT")),U)&($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,14)'="Y")) ;abm*2.6*2 3PMS10003A
;S ABM("PPDU")=+$P($G(^ABMDFEE(ABMP("FEE"),25,X,0)),"^",2) ;abm*2.6*2 3PMS10003A
S ABM("PPDU")=+$P($$ONE^ABMFEAPI(ABMP("FEE"),25,X,ABMP("VDT")),U) ;abm*2.6*2 3PMS10003A
S:'ABM("PPDU") ABM("PPDU")=+$P($G(^PSDRUG(X,660)),"^",6)
K DR
S DR=".03////"_ABM("QTY")_";.04////"_ABM("PPDU")_";.05////"_ABM("SURC")_";.06////"_ABM("RX")_";.14////"_ABM("TIME")
;Next line set correspond diagnosis if only 1 POV
I $D(ABMP("CORRSDIAG")) S DR=DR_";.13////1"
S DR=DR_";.17////"_ABMSRC
D ^DIE
Q
ABMDVST5 ; IHS/ASDST/DMJ - PCC VISIT STUFF - PART 6 (PHARMACY) ;
+1 ;;2.6;IHS Third Party Billing System;**2,4**;NOV 12, 2009
+2 ;Original;TMD;08/19/96 5:01 PM
+3 ;
+4 ; IHS/SD/SDR - v2.5 p8 - task 57
+5 ; Removed check for OTC drugs and no entry in fee schedule. Also
+6 ; added code to populate dt disc. and RTS if flag is set.
+7 ; IHS/SD/SDR - v2.5 p9 - IM19140 - <SUBSCRIPT>ABMDVST5+29^ABMDVST5
+8 ; IHS/SD/SDR - v2.5 p10 - IM21500 - Added code to check new V Med field
+9 ; POINT OF SALE BILLING STATUS and only bill if blank or rejected
+10 ;
+11 IF $GET(ABMP("RXDONE"))
QUIT
+12 IF $GET(ABMP("INS"))'=""
IF ($PIECE($GET(^AUTNINS(ABMP("INS"),2)),U,3)="U")
QUIT
+13 IF $GET(ABMP("INS"))'=""
IF ($PIECE($GET(^AUTNINS(ABMP("INS"),2)),"^",3)="P")
QUIT
+14 SET (ABM("TIME"),ABMR("TIME"))=$PIECE(ABMP("V0"),U)
+15 ;
MED ;
+1 KILL DIC
+2 SET DA(1)=ABMP("CDFN")
SET DIC="^ABMDCLM(DUZ(2),"_DA(1)_",23,"
SET DIC(0)="LE"
+3 SET ABM=0
FOR
SET ABM=$ORDER(^AUPNVMED("AD",ABMVDFN,ABM))
IF 'ABM
QUIT
Begin DoDot:1
+4 IF '$DATA(^AUPNVMED(ABM,0))
QUIT
+5 IF $PIECE(^AUPNVMED(ABM,0),"^",8)&($GET(ABMRXFLG)'=1)
QUIT
+6 SET X=$PIECE(^AUPNVMED(ABM,0),U)
+7 SET ABMSRC="14|"_ABM_"|RX"
+8 DO MEDCHK
+9 IF ABMR("QTY")=""&($GET(ABMRXFLG)'=1)
QUIT
+10 IF $GET(ABMR("RTS"))&($GET(ABMRXFLG)'=1)
QUIT
+11 DO MEDSET
End DoDot:1
Q KILL DIC,ABMR,DR,DIE,X,Y
+1 QUIT
+2 ;
MEDCHK ;
+1 SET ABMR("X")=$ORDER(^PSRX("APCC",ABM,""))
+2 IF ABMR("X")=""
DO NORX
QUIT
+3 SET ABMR("RX")=$PIECE($GET(^PSRX(ABMR("X"),0)),U)
+4 IF ABMR("RX")=""
DO NORX
QUIT
+5 SET ABMR("DTWR")=$PIECE(^PSRX(ABMR("X"),0),"^",13)
+6 SET ABMR("REF")=$ORDER(^PSRX("APCC",ABM,ABMR("X"),0))
+7 IF ABMR("REF")=""
Begin DoDot:1
+8 SET ABMR0=$GET(^PSRX(ABMR("X"),0))
+9 SET ABMR2=$GET(^PSRX(ABMR("X"),2))
+10 SET ABMR("QTY")=$PIECE(ABMR0,"^",7)
+11 SET ABMR("RTS")=$PIECE(ABMR2,"^",15)
+12 SET ABMR("DAYS")=$PIECE(ABMR0,"^",8)
+13 SET ABMR("NDC")=$PIECE(ABMR2,"^",7)
+14 SET ABMR("PROV")=$PIECE(ABMR0,"^",4)
End DoDot:1
+15 IF ABMR("REF")'=""
Begin DoDot:1
+16 SET ABMR0=$GET(^PSRX(ABMR("X"),1,ABMR("REF"),0))
+17 SET ABMR("QTY")=$PIECE(ABMR0,"^",4)
+18 SET ABMR("RTS")=$PIECE(ABMR0,"^",16)
+19 SET ABMR("DAYS")=$PIECE(ABMR0,"^",10)
+20 SET ABMR("NDC")=$$NDCVAL^ABMPFUNC(ABMR("X"),ABMR("REF"))
+21 SET ABMR("PROV")=$PIECE(ABMR0,"^",17)
End DoDot:1
+22 QUIT
NORX ;no entry in prescription file
+1 SET ABMR("QTY")=$PIECE(^AUPNVMED(ABM,0),"^",6)
+2 SET ABMR("RX")=""
+3 QUIT
MEDSET ;FILE
+1 SET DA=$ORDER(^ABMDCLM(DUZ(2),DA(1),"ASRC",ABMSRC,0))
+2 ;For duplicates problem
IF DA
IF '$DATA(@(DIC_DA_",0)"))
SET DA=""
+3 ;abm*2.6*2 3PMS10003A ;abm*2.6*4 NOHEAT
SET ABMR("PPDU")=+$PIECE($$ONE^ABMFEAPI(ABMP("FEE"),25,X,ABMP("VDT")),U)
+4 ;abm*2.6*4 NOHEAT
IF 'ABMR("PPDU")
SET ABMR("PPDU")=+$PIECE($GET(^PSDRUG(X,660)),U,6)
+5 ;abm*2.6*4 NOHEAT
IF (($PIECE($$ONE^ABMFEAPI(ABMP("FEE"),25,X,ABMP("VDT")),U)=0)&('ABMR("PPDU"))&($PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,14)'="Y"))
QUIT
+6 IF 'DA
Begin DoDot:1
+7 SET DIC("P")=$PIECE(^DD(9002274.3,23,0),U,2)
+8 ; ADD DEFAULT REV CODE
+9 SET DIC("DR")=".02////250"
+10 KILL DD,DO
DO FILE^DICN
+11 KILL DIC("DR")
+12 SET DA=+Y
End DoDot:1
+13 IF DA<0
QUIT
SET DIE=DIC
+14 SET ABMR("SURC")=$SELECT(ABMP("VTYP")'=111:$PIECE(^ABMDPARM(DUZ(2),1,0),U,3),1:$PIECE($GET(^ABMDPARM(DUZ(2),1,4)),U,6))
+15 ;X is the drug ien. ABMDFEE is dinumed in this mult
+16 ;Q:($P($G(^ABMDFEE(ABMP("FEE"),25,X,0)),U,2)=0&($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,14)'="Y")) ;abm*2.6*2 3PMS10003A
+17 ;Q:($P($$ONE^ABMFEAPI(ABMP("FEE"),25,X,ABMP("VDT")),U)=0&($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,14)'="Y")) ;abm*2.6*2 3PMS10003A ;abm*2.6*4 NOHEAT
+18 ;S ABMR("PPDU")=+$P($G(^ABMDFEE(ABMP("FEE"),25,X,0)),U,2) ;abm*2.6*2 3PMS10003A
+19 ;S ABMR("PPDU")=+$P($$ONE^ABMFEAPI(ABMP("FEE"),25,X,ABMP("VDT")),U) ;abm*2.6*2 3PMS10003A ;abm*2.6*4 NOHEAT
+20 ;S:'ABMR("PPDU") ABMR("PPDU")=+$P($G(^PSDRUG(X,660)),U,6) ;abm*2.6*4 NOHEAT
+21 KILL DR
+22 SET DR=".03////"_ABMR("QTY")_";.04////"_ABMR("PPDU")_";.05////"_ABMR("SURC")_";.06////"_ABMR("RX")_";.14////"_ABMR("TIME")
+23 ;Next line set correspond diagnosis if only 1 POV
+24 IF $DATA(ABMP("CORRSDIAG"))
SET DR=DR_";.13////1"
+25 SET DR=DR_";.17////"_ABMSRC
+26 DO ^DIE
+27 SET DR=".22////"_ABMR("X")
+28 DO ^DIE
+29 SET DR=".23////"_$GET(ABMR("PROV"))
+30 DO ^DIE
+31 SET DR=".24////"_$GET(ABMR("NDC"))
+32 DO ^DIE
+33 SET DR=".2////"_$GET(ABMR("DAYS"))
+34 DO ^DIE
+35 SET DR=".19////"_+$GET(ABMR("REF"))
+36 DO ^DIE
+37 SET DR=".25////"_$GET(ABMR("DTWR"))
+38 DO ^DIE
+39 SET ABMP("RXDONE")=1
+40 IF $GET(ABMRXFLG)=1
Begin DoDot:1
+41 SET DR=".26////"_$PIECE($GET(^AUPNVMED(ABM,0)),U,8)
+42 SET DR=DR_";.27////"_$GET(ABMR("RTS"))
+43 DO ^DIE
End DoDot:1
+44 QUIT
+45 ;
MED3 ;EP
+1 ; 4/26/01 - This code is no longer called... leaving in routine for
+2 ; version just in case...
+3 IF $PIECE($GET(^AUTNINS(ABMP("INS"),2)),U,3)="U"
QUIT
+4 IF $DATA(ABMP("MEDSCHKD"))
QUIT
+5 SET DA(1)=ABMP("CDFN")
SET DIC="^ABMDCLM(DUZ(2),"_DA(1)_",23,"
SET DIC(0)="LE"
+6 SET ABM("D")=ABMCHVDT-1
+7 ;ABM("ED") is the discharge date if it exists
+8 SET ABM("ED")=$SELECT($PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),6)),U,3):$PIECE(^(6),U,3),1:ABMCHVDT)+.24
+9 FOR
SET ABM("D")=$ORDER(^PSRX("AD",ABM("D")))
IF 'ABM("D")!(ABM("D")>ABM("ED"))
QUIT
Begin DoDot:1
+10 SET ABM("X")=0
FOR
SET ABM("X")=$ORDER(^PSRX("AD",ABM("D"),ABM("X")))
IF 'ABM("X")
QUIT
IF $PIECE($GET(^PSRX(ABM("X"),0)),U,2)=ABMP("PDFN")
DO MED3CK
End DoDot:1
+11 KILL DIC
+12 QUIT
+13 ;
MED3CK IF $DATA(^PSRX("AD",ABM("D"),ABM("X")))=11
SET ABM("REF")=$ORDER(^PSRX("AD",ABM("D"),ABM("X"),""))
+1 IF '$TEST
SET ABM("REF")=""
+2 SET X=$PIECE(^PSRX(ABM("X"),0),U,6)
SET ABM("RX")=$PIECE(^(0),U)
SET ABM("QTY")=$SELECT('+ABM("REF"):$PIECE(^(0),U,7),1:$PIECE($GET(^(1,ABM("REF"),0)),U,4))
+3 SET ABMSRC="PSRX|"_ABM("X")_"|RX"
+4 IF ABM("QTY")=""
QUIT
+5 IF '$DATA(^PSDRUG(X,0))
QUIT
+6 ;OTC DRUG
IF $PIECE(^PSDRUG(X,0),"^",3)[9
QUIT
+7 SET DA=$ORDER(^ABMDCLM(DUZ(2),DA(1),"ASRC",ABMSRC,0))
+8 ;For duplicates problem
IF DA
IF '$DATA(@(DIC_DA_",0)"))
SET DA=""
+9 IF 'DA
Begin DoDot:1
+10 SET ABMP("MEDSCHKD")=1
+11 SET DIC("P")=$PIECE(^DD(9002274.3,23,0),U,2)
+12 SET DIC("DR")=".02////250"
+13 KILL DD,DO
DO FILE^DICN
+14 KILL DIC("DR")
+15 SET DA=+Y
End DoDot:1
+16 IF DA<0
QUIT
SET DIE=DIC
+17 SET ABM("SURC")=$SELECT(ABMP("VTYP")'=111:+$PIECE(^ABMDPARM(DUZ(2),1,0),U,3),1:+$PIECE($GET(^ABMDPARM(DUZ(2),1,4)),"^",6))
+18 ;Q:($P($G(^ABMDFEE(ABMP("FEE"),25,X,0)),U,2)&($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,14)'="Y")) ;abm*2.6*2 3PMS10003A
+19 ;abm*2.6*2 3PMS10003A
IF ($PIECE($$ONE^ABMFEAPI(ABMP("FEE"),25,X,ABMP("VDT")),U)&($PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,14)'="Y"))
QUIT
+20 ;S ABM("PPDU")=+$P($G(^ABMDFEE(ABMP("FEE"),25,X,0)),"^",2) ;abm*2.6*2 3PMS10003A
+21 ;abm*2.6*2 3PMS10003A
SET ABM("PPDU")=+$PIECE($$ONE^ABMFEAPI(ABMP("FEE"),25,X,ABMP("VDT")),U)
+22 IF 'ABM("PPDU")
SET ABM("PPDU")=+$PIECE($GET(^PSDRUG(X,660)),"^",6)
+23 KILL DR
+24 SET DR=".03////"_ABM("QTY")_";.04////"_ABM("PPDU")_";.05////"_ABM("SURC")_";.06////"_ABM("RX")_";.14////"_ABM("TIME")
+25 ;Next line set correspond diagnosis if only 1 POV
+26 IF $DATA(ABMP("CORRSDIAG"))
SET DR=DR_";.13////1"
+27 SET DR=DR_";.17////"_ABMSRC
+28 DO ^DIE
+29 QUIT
