- BEX80 ; cmi/anch/maw - BEX IHS Audiocare Supplements ; [ 03/02/2010 11:04 AM ]
- ;;1.0;BEX TELEPHONE REFILL SYSTEM;**1,2,4**;DEC 01, 2009
- PATRX ;EP - PRINT ALL TRANSACTINS FOR ONE PATIENT
- ;CALLED FROM OPTION 'BEX PATIENT TRANSACTIONS'
- N VEX
- S DIC="^DPT(",DIC(0)="AEMQ",L=0
- S DIC("S")="I $D(^VEXHRX0(19080.1,""B"",+Y))"
- D ^DIC Q:Y=-1
- S VEX=+Y
- S DIC="^VEXHRX0(19080.1,"
- ;S BY="@INTERNAL(#.01)=VAR(""VEX"");S1,@+DATE(DATE/TIME),PRESCRIPTION NUMBER"
- S BY="@INTERNAL(#.01);S1,@+DATE(DATE/TIME),PRESCRIPTION NUMBER"
- S (FR,TO)=VEX
- S DHD="[BEX PATIENT TRANSACTIONS]"
- S FLDS="1;C1;N,!2,3,4,8"
- D EN1^DIP
- Q
- ;
- DRG(VEXDRX) ;EP - return the drug name
- N BEXXDA,VEXDIEN
- I '$G(BEXDRX) Q ""
- S BEXXDA=$O(^PSRX("B",BEXDRX,0))
- I '$G(BEXXDA) Q ""
- S BEXDIEN=$P($G(^PSRX(BEXXDA,0)),U,6)
- I '$G(BEXDIEN) Q ""
- Q $P($G(^PSDRUG(BEXDIEN,0)),U)
- ;
- BEX80 ; cmi/anch/maw - BEX IHS Audiocare Supplements ; [ 03/02/2010 11:04 AM ]
- +1 ;;1.0;BEX TELEPHONE REFILL SYSTEM;**1,2,4**;DEC 01, 2009
- PATRX ;EP - PRINT ALL TRANSACTINS FOR ONE PATIENT
- +1 ;CALLED FROM OPTION 'BEX PATIENT TRANSACTIONS'
- +2 NEW VEX
- +3 SET DIC="^DPT("
- SET DIC(0)="AEMQ"
- SET L=0
- +4 SET DIC("S")="I $D(^VEXHRX0(19080.1,""B"",+Y))"
- +5 DO ^DIC
- IF Y=-1
- QUIT
- +6 SET VEX=+Y
- +7 SET DIC="^VEXHRX0(19080.1,"
- +8 ;S BY="@INTERNAL(#.01)=VAR(""VEX"");S1,@+DATE(DATE/TIME),PRESCRIPTION NUMBER"
- +9 SET BY="@INTERNAL(#.01);S1,@+DATE(DATE/TIME),PRESCRIPTION NUMBER"
- +10 SET (FR,TO)=VEX
- +11 SET DHD="[BEX PATIENT TRANSACTIONS]"
- +12 SET FLDS="1;C1;N,!2,3,4,8"
- +13 DO EN1^DIP
- +14 QUIT
- +15 ;
- DRG(VEXDRX) ;EP - return the drug name
- +1 NEW BEXXDA,VEXDIEN
- +2 IF '$GET(BEXDRX)
- QUIT ""
- +3 SET BEXXDA=$ORDER(^PSRX("B",BEXDRX,0))
- +4 IF '$GET(BEXXDA)
- QUIT ""
- +5 SET BEXDIEN=$PIECE($GET(^PSRX(BEXXDA,0)),U,6)
- +6 IF '$GET(BEXDIEN)
- QUIT ""
- +7 QUIT $PIECE($GET(^PSDRUG(BEXDIEN,0)),U)
- +8 ;