ABSPOSN2 ; IHS/FCS/DRS - NCPDP Fms F ILC A/R ; [ 09/12/2002 10:16 AM ]
;;1.0;PHARMACY POINT OF SALE;**3**;JUN 21, 2001;Build 38
;----------------------------------------------------------------------
;----------------------------------------------------------------------
PBITEM(BITEMIEN) ;EP
;Manage local variables
N PATIEN,LITEMIEN,VSTIEN,IADTINS,IADTTYP,INSDATA,VMEDS,SVMEDS,DATEW
N NMEDS,NFORMS,INDEX,START,END,PATINFO,INSINFO,PHARINFO,DRUGINFO
N INSTYPE
N PCNDFN S PCNDFN=BITEMIEN
;
;Make sure input variables are defined
Q:$G(BITEMIEN)=""
Q:'$D(^ABSBITMS(9002302,BITEMIEN,0))
;
S PATIEN=$P($G(^ABSBITMS(9002302,BITEMIEN,0)),U,2)
Q:PATIEN=""
Q:'$D(^DPT(PATIEN,0))
;
S LITEMIEN=$O(^ABSBITMS(9002302,BITEMIEN,1,0))
Q:'+LITEMIEN
;
S VSTIEN=$P($G(^ABSBITMS(9002302,BITEMIEN,1,LITEMIEN,0)),U,3)
Q:VSTIEN=""
Q:'$D(^AUPNVSIT(VSTIEN,0))
;
S DIPA("VCN")=$P($G(^ABSBITMS(9002302,BITEMIEN,"VCN")),U,1)
;
; INSurance: S IADTINS,IADTTYP,INSDATA,INSTYPE
;
S IADTINS=$P($G(^ABSBITMS(9002302,BITEMIEN,0)),U,4)
I 'IADTINS S IADTINS=1 ; DRS; 04/13/2000
I $D(^ABSBITMS(9002302,BITEMIEN,"INSCOV1")) D
. K IADTTYPE ; no longer applicable
. M INSDATA=^ABSBITMS(9002302,BITEMIEN,"INSCOV1",IADTINS)
. S INSTYPE="INSCOV1"
E D ; Old INSCOV data structures
. S IADTTYP=$O(^ABSBITMS(9002302,BITEMIEN,"INSCOV",IADTINS,""))
. ;Q:IADTTYP'="PRVT"
. ;added INSNXT stuff to get past private INS only
. N INSNXT
. S INSNXT=$O(^ABSBITMS(9002302,BITEMIEN,"INSCOV",IADTINS,""))
. Q:INSNXT=""
. S INSDATA=$G(^ABSBITMS(9002302,BITEMIEN,"INSCOV",IADTINS,INSNXT,0))
. S INSTYPE=INSNXT ;="PRVT" or "CAID" or...
. ; what INSDATA means depENDs on INSTYPE
;
D GETVMED(BITEMIEN,.VMEDS)
Q:+$G(VMEDS(0))=0
;I BITEMIEN=130417,+$H=58185 U $P ZW VMEDS R ">>>",%
;Get PATient, INSurer, and PHARmacy inFmation
D PATINFO^ABSPOSN3(PATIEN,.PATINFO)
D INSINFO^ABSPOSN3(.INSDATA,.INSINFO,INSTYPE)
D PHARINFO^ABSPOSN3(.PHARINFO,$P(VMEDS(1),U,6))
;
;Sort V Medications by DATE RX Written
D SORTVMED(.VMEDS,.SVMEDS)
;I BITEMIEN=130417,+$H=58185 U $P ZW SVMEDS R ">>>",%
Q:'$D(SVMEDS)
U IO
S DATEW=0
F D Q:'+DATEW
.S DATEW=$O(SVMEDS(DATEW))
.Q:'+DATEW
.S NMEDS=+$G(SVMEDS(DATEW,0))
.Q:NMEDS=0
.S NFORMS=((NMEDS-1)\2)+1
.F INDEX=1:1:NFORMS D
..S START=((INDEX-1)*2)+1
..S END=START+2-1
..S:END>NMEDS END=NMEDS
..K DRUGINFO
..S DRUGINFO(0)=$S(START=END:1,1:2)
..;D DRUGINFO^ABSPOSN3(VMEDS(START),1,.DRUGINFO)
..;D:'(START=END) DRUGINFO^ABSPOSN3(VMEDS(END),2,.DRUGINFO)
..D DRUGINFO^ABSPOSN3(VMEDS(SVMEDS(DATEW,START)),1,.DRUGINFO)
..D:START'=END DRUGINFO^ABSPOSN3(VMEDS(SVMEDS(DATEW,END)),2,.DRUGINFO)
..D PFM^ABSPOSN6
Q
;----------------------------------------------------------------------
;Given a Billing ITEMs Record IEN number, this routine loops through
;the V CPT multiple and returns all V Medication ITEMs.
;
;Parameters: BITEMIEN - Billing ITEMs IEN (9002302)
; .VMEDS - Array of V Medication IEN #s (9000010.14)
; VMEDS(0) = <Total Number>
; VMEDS(N) = <V Medication IEN>
;----------------------------------------------------------------------
GETVMED(BITEMIEN,VMEDS) ;
;Manage local variables
N NEXT,COUNT,VCPTIEN,RXIEN,RXRFIEN,VMEDIEN,RXWDATE,F57IEN
;
;Make sure input varaibles are defined
Q:$G(BITEMIEN)=""
Q:'$D(^ABSBITMS(9002302,BITEMIEN,0))
;
S (NEXT,COUNT)=0
F D Q:'+NEXT
.S NEXT=$O(^ABSBITMS(9002302,BITEMIEN,"VCPT",NEXT))
.Q:'+NEXT
.;
.S VCPTIEN=$P($G(^ABSBITMS(9002302,BITEMIEN,"VCPT",NEXT,0)),U,1)
.Q:VCPTIEN=""
.Q:'$D(^ABSVCPT(9002301,VCPTIEN,0))
.;
.;
.S VMEDIEN=$P($G(^ABSVCPT(9002301,VCPTIEN,"SPEC")),U,2)
.S RXIEN=$P($G(^ABSVCPT(9002301,VCPTIEN,"SPEC")),U,1) ;12.29.99
.S F57IEN=$P($G(^ABSVCPT(9002301,VCPTIEN,"SPEC")),U,4) ;04/20/2000
.I F57IEN S RXRFIEN=$P($G(^ABSPTL(F57IEN,1)),U)
.I RXIEN,'VMEDIEN S VMEDIEN=$P($G(^PSRX(RXIEN,999999911)),U,1)
.;
.I VMEDIEN=""&('RXIEN) D Q
. . S VDATE=$P($G(^ABSVCPT(9002301,VCPTIEN,"BATCH")),U,7)
. . S COUNT=COUNT+1
. . S $P(VMEDS(COUNT),U,5)=VCPTIEN
. . S $P(VMEDS(COUNT),U,4)=VDATE
. . S VMEDS(0)=COUNT
.;
.;Q:'$D(^AUPNVMED(VMEDIEN,0))
.;
.I VMEDIEN&('RXIEN) D
. . S RXIEN=$O(^PSRX("APCC",VMEDIEN,""))
. . Q:RXIEN=""
.I VMEDIEN,RXIEN,'$G(RXRFIEN) S RXRFIEN=$O(^PSRX("APCC",VMEDIEN,RXIEN,""))
.;
.Q:'RXIEN
.Q:'$D(^PSRX(RXIEN,0))
.;
.;Determine RX Written DATE
.S RXWDATE=$P($G(^PSRX(RXIEN,0)),U,13)
.;Q:RXWDATE=""
.S RXWDATE=$S(RXWDATE'="":RXWDATE,1:VDATE)
.S COUNT=COUNT+1
.S VMEDS(COUNT)=$G(VMEDIEN)_U_$G(RXIEN)_U_$G(RXRFIEN)_U_RXWDATE_U_VCPTIEN_U_F57IEN
;
S VMEDS(0)=COUNT
Q
;---------------------------------------------------------------------
SORTVMED(VMEDS,SVMEDS) ;
;Manage local varables
N INDEX,DATE
;
Q:$G(VMEDS(0))=""
;
F INDEX=1:1:VMEDS(0) D
.S DATE=$P($G(VMEDS(INDEX)),U,4)
.Q:DATE=""
.S SVMEDS(DATE,0)=$G(SVMEDS(DATE,0))+1
.S SVMEDS(DATE,SVMEDS(DATE,0))=INDEX
Q
ABSPOSN2 ; IHS/FCS/DRS - NCPDP Fms F ILC A/R ; [ 09/12/2002 10:16 AM ]
+1 ;;1.0;PHARMACY POINT OF SALE;**3**;JUN 21, 2001;Build 38
+2 ;----------------------------------------------------------------------
+3 ;----------------------------------------------------------------------
PBITEM(BITEMIEN) ;EP
+1 ;Manage local variables
+2 NEW PATIEN,LITEMIEN,VSTIEN,IADTINS,IADTTYP,INSDATA,VMEDS,SVMEDS,DATEW
+3 NEW NMEDS,NFORMS,INDEX,START,END,PATINFO,INSINFO,PHARINFO,DRUGINFO
+4 NEW INSTYPE
+5 NEW PCNDFN
SET PCNDFN=BITEMIEN
+6 ;
+7 ;Make sure input variables are defined
+8 IF $GET(BITEMIEN)=""
QUIT
+9 IF '$DATA(^ABSBITMS(9002302,BITEMIEN,0))
QUIT
+10 ;
+11 SET PATIEN=$PIECE($GET(^ABSBITMS(9002302,BITEMIEN,0)),U,2)
+12 IF PATIEN=""
QUIT
+13 IF '$DATA(^DPT(PATIEN,0))
QUIT
+14 ;
+15 SET LITEMIEN=$ORDER(^ABSBITMS(9002302,BITEMIEN,1,0))
+16 IF '+LITEMIEN
QUIT
+17 ;
+18 SET VSTIEN=$PIECE($GET(^ABSBITMS(9002302,BITEMIEN,1,LITEMIEN,0)),U,3)
+19 IF VSTIEN=""
QUIT
+20 IF '$DATA(^AUPNVSIT(VSTIEN,0))
QUIT
+21 ;
+22 SET DIPA("VCN")=$PIECE($GET(^ABSBITMS(9002302,BITEMIEN,"VCN")),U,1)
+23 ;
+24 ; INSurance: S IADTINS,IADTTYP,INSDATA,INSTYPE
+25 ;
+26 SET IADTINS=$PIECE($GET(^ABSBITMS(9002302,BITEMIEN,0)),U,4)
+27 ; DRS; 04/13/2000
IF 'IADTINS
SET IADTINS=1
+28 IF $DATA(^ABSBITMS(9002302,BITEMIEN,"INSCOV1"))
Begin DoDot:1
+29 ; no longer applicable
KILL IADTTYPE
+30 MERGE INSDATA=^ABSBITMS(9002302,BITEMIEN,"INSCOV1",IADTINS)
+31 SET INSTYPE="INSCOV1"
End DoDot:1
+32 ; Old INSCOV data structures
IF '$TEST
Begin DoDot:1
+33 SET IADTTYP=$ORDER(^ABSBITMS(9002302,BITEMIEN,"INSCOV",IADTINS,""))
+34 ;Q:IADTTYP'="PRVT"
+35 ;added INSNXT stuff to get past private INS only
+36 NEW INSNXT
+37 SET INSNXT=$ORDER(^ABSBITMS(9002302,BITEMIEN,"INSCOV",IADTINS,""))
+38 IF INSNXT=""
QUIT
+39 SET INSDATA=$GET(^ABSBITMS(9002302,BITEMIEN,"INSCOV",IADTINS,INSNXT,0))
+40 ;="PRVT" or "CAID" or...
SET INSTYPE=INSNXT
+41 ; what INSDATA means depENDs on INSTYPE
End DoDot:1
+42 ;
+43 DO GETVMED(BITEMIEN,.VMEDS)
+44 IF +$GET(VMEDS(0))=0
QUIT
+45 ;I BITEMIEN=130417,+$H=58185 U $P ZW VMEDS R ">>>",%
+46 ;Get PATient, INSurer, and PHARmacy inFmation
+47 DO PATINFO^ABSPOSN3(PATIEN,.PATINFO)
+48 DO INSINFO^ABSPOSN3(.INSDATA,.INSINFO,INSTYPE)
+49 DO PHARINFO^ABSPOSN3(.PHARINFO,$PIECE(VMEDS(1),U,6))
+50 ;
+51 ;Sort V Medications by DATE RX Written
+52 DO SORTVMED(.VMEDS,.SVMEDS)
+53 ;I BITEMIEN=130417,+$H=58185 U $P ZW SVMEDS R ">>>",%
+54 IF '$DATA(SVMEDS)
QUIT
+55 USE IO
+56 SET DATEW=0
+57 FOR
Begin DoDot:1
+58 SET DATEW=$ORDER(SVMEDS(DATEW))
+59 IF '+DATEW
QUIT
+60 SET NMEDS=+$GET(SVMEDS(DATEW,0))
+61 IF NMEDS=0
QUIT
+62 SET NFORMS=((NMEDS-1)\2)+1
+63 FOR INDEX=1:1:NFORMS
Begin DoDot:2
+64 SET START=((INDEX-1)*2)+1
+65 SET END=START+2-1
+66 IF END>NMEDS
SET END=NMEDS
+67 KILL DRUGINFO
+68 SET DRUGINFO(0)=$SELECT(START=END:1,1:2)
+69 ;D DRUGINFO^ABSPOSN3(VMEDS(START),1,.DRUGINFO)
+70 ;D:'(START=END) DRUGINFO^ABSPOSN3(VMEDS(END),2,.DRUGINFO)
+71 DO DRUGINFO^ABSPOSN3(VMEDS(SVMEDS(DATEW,START)),1,.DRUGINFO)
+72 IF START'=END
DO DRUGINFO^ABSPOSN3(VMEDS(SVMEDS(DATEW,END)),2,.DRUGINFO)
+73 DO PFM^ABSPOSN6
End DoDot:2
End DoDot:1
IF '+DATEW
QUIT
+74 QUIT
+75 ;----------------------------------------------------------------------
+76 ;Given a Billing ITEMs Record IEN number, this routine loops through
+77 ;the V CPT multiple and returns all V Medication ITEMs.
+78 ;
+79 ;Parameters: BITEMIEN - Billing ITEMs IEN (9002302)
+80 ; .VMEDS - Array of V Medication IEN #s (9000010.14)
+81 ; VMEDS(0) = <Total Number>
+82 ; VMEDS(N) = <V Medication IEN>
+83 ;----------------------------------------------------------------------
GETVMED(BITEMIEN,VMEDS) ;
+1 ;Manage local variables
+2 NEW NEXT,COUNT,VCPTIEN,RXIEN,RXRFIEN,VMEDIEN,RXWDATE,F57IEN
+3 ;
+4 ;Make sure input varaibles are defined
+5 IF $GET(BITEMIEN)=""
QUIT
+6 IF '$DATA(^ABSBITMS(9002302,BITEMIEN,0))
QUIT
+7 ;
+8 SET (NEXT,COUNT)=0
+9 FOR
Begin DoDot:1
+10 SET NEXT=$ORDER(^ABSBITMS(9002302,BITEMIEN,"VCPT",NEXT))
+11 IF '+NEXT
QUIT
+12 ;
+13 SET VCPTIEN=$PIECE($GET(^ABSBITMS(9002302,BITEMIEN,"VCPT",NEXT,0)),U,1)
+14 IF VCPTIEN=""
QUIT
+15 IF '$DATA(^ABSVCPT(9002301,VCPTIEN,0))
QUIT
+16 ;
+17 ;
+18 SET VMEDIEN=$PIECE($GET(^ABSVCPT(9002301,VCPTIEN,"SPEC")),U,2)
+19 ;12.29.99
SET RXIEN=$PIECE($GET(^ABSVCPT(9002301,VCPTIEN,"SPEC")),U,1)
+20 ;04/20/2000
SET F57IEN=$PIECE($GET(^ABSVCPT(9002301,VCPTIEN,"SPEC")),U,4)
+21 IF F57IEN
SET RXRFIEN=$PIECE($GET(^ABSPTL(F57IEN,1)),U)
+22 IF RXIEN
IF 'VMEDIEN
SET VMEDIEN=$PIECE($GET(^PSRX(RXIEN,999999911)),U,1)
+23 ;
+24 IF VMEDIEN=""&('RXIEN)
Begin DoDot:2
+25 SET VDATE=$PIECE($GET(^ABSVCPT(9002301,VCPTIEN,"BATCH")),U,7)
+26 SET COUNT=COUNT+1
+27 SET $PIECE(VMEDS(COUNT),U,5)=VCPTIEN
+28 SET $PIECE(VMEDS(COUNT),U,4)=VDATE
+29 SET VMEDS(0)=COUNT
End DoDot:2
QUIT
+30 ;
+31 ;Q:'$D(^AUPNVMED(VMEDIEN,0))
+32 ;
+33 IF VMEDIEN&('RXIEN)
Begin DoDot:2
+34 SET RXIEN=$ORDER(^PSRX("APCC",VMEDIEN,""))
+35 IF RXIEN=""
QUIT
End DoDot:2
+36 IF VMEDIEN
IF RXIEN
IF '$GET(RXRFIEN)
SET RXRFIEN=$ORDER(^PSRX("APCC",VMEDIEN,RXIEN,""))
+37 ;
+38 IF 'RXIEN
QUIT
+39 IF '$DATA(^PSRX(RXIEN,0))
QUIT
+40 ;
+41 ;Determine RX Written DATE
+42 SET RXWDATE=$PIECE($GET(^PSRX(RXIEN,0)),U,13)
+43 ;Q:RXWDATE=""
+44 SET RXWDATE=$SELECT(RXWDATE'="":RXWDATE,1:VDATE)
+45 SET COUNT=COUNT+1
+46 SET VMEDS(COUNT)=$GET(VMEDIEN)_U_$GET(RXIEN)_U_$GET(RXRFIEN)_U_RXWDATE_U_VCPTIEN_U_F57IEN
End DoDot:1
IF '+NEXT
QUIT
+47 ;
+48 SET VMEDS(0)=COUNT
+49 QUIT
+50 ;---------------------------------------------------------------------
SORTVMED(VMEDS,SVMEDS) ;
+1 ;Manage local varables
+2 NEW INDEX,DATE
+3 ;
+4 IF $GET(VMEDS(0))=""
QUIT
+5 ;
+6 FOR INDEX=1:1:VMEDS(0)
Begin DoDot:1
+7 SET DATE=$PIECE($GET(VMEDS(INDEX)),U,4)
+8 IF DATE=""
QUIT
+9 SET SVMEDS(DATE,0)=$GET(SVMEDS(DATE,0))+1
+10 SET SVMEDS(DATE,SVMEDS(DATE,0))=INDEX
End DoDot:1
+11 QUIT
