- PSOHDR ;BIR/RTR-Send order update message to HDR ;06/27/03
- ;;7.0;OUTPATIENT PHARMACY;**181,205**;DEC 1997
- ;External reference to PSDRUG supported by DBIA 221
- ;External reference to VDEFQM supported by DBIA 4253
- ;
- ;PSOHDRTP = Type of message, PRES=fill, PPAR=partial, PREF=refill
- ;PSOHDRNM = Internal entry number of order
- ;
- EN(PSOHDRTP,PSOHDRNM) ; Entry point for VDEF calls
- Q:'$G(PSOHDRNM)
- Q:$G(PSOHDRTP)=""
- I $T(QUEUE^VDEFQM)']"" Q
- I '$D(^PSRX(PSOHDRNM,0)) Q
- ;Check for test patient
- I $T(TESTPAT^VADPT)]"" Q:$$TESTPAT^VADPT(+$P($G(^PSRX(PSOHDRNM,0)),"^",2))
- N PSOHDRX,PSOHDRA,PSOHDRB
- S PSOHDRA=$S(PSOHDRTP="PRES":"RDE^O11",PSOHDRTP="PPAR":"RDS^O13",PSOHDRTP="PREF":"RDS^O13",1:"")
- Q:PSOHDRA=""
- S PSOHDRB="SUBTYPE="_PSOHDRTP_"^IEN="_PSOHDRNM
- S PSOHDRX=$$QUEUE^VDEFQM(PSOHDRA,PSOHDRB)
- Q
- ;
- ;Return NDC number
- NDC(PSOVIEN,PSOVFILL,PSOVTYPE) ;
- ;PSOVIEN = Internal prescription number
- ;PSOVFILL = Fill Number
- ;PSOVTYPE = "R" for refill, "P" for Partial
- N PSOVNDC,PSOVNX,PSOVY,PSOVDRG
- S (PSOVNDC,PSOVNX)=""
- I $G(PSOVIEN)'>0 Q PSOVNDC
- I '$D(^PSRX(PSOVIEN,0)) Q PSOVNDC
- I $G(PSOVFILL)="" Q PSOVNDC
- I PSOVFILL=0 D D:PSOVNX'="" FORMAT Q PSOVNDC
- .D CMOP I PSOVNX'="" Q
- .;I $P($G(^PSRX(PSOVIEN,"NDC")),"^")'="" S PSOVNX=$P(^("NDC"),"^") Q
- .I $P($G(^PSRX(PSOVIEN,2)),"^",7)'="" S PSOVNX=$P(^(2),"^",7) Q
- .D DRUG
- I $G(PSOVFILL)'>0 Q PSOVNDC
- I $G(PSOVTYPE)'="R",$G(PSOVTYPE)'="P" Q PSOVNDC
- I PSOVTYPE="R" D D:PSOVNX'="" FORMAT Q PSOVNDC
- .D CMOP I PSOVNX'="" Q
- .;I $P($G(^PSRX(PSOVIEN,1,PSOVFILL,"NDC")),"^")'="" S PSOVNX=$P(^("NDC"),"^") Q
- .I $P($G(^PSRX(PSOVIEN,1,PSOVFILL,1)),"^",3)'="" S PSOVNX=$P(^(1),"^",3) Q
- .D DRUG
- I PSOVTYPE="P" D D:PSOVNX'="" FORMAT Q PSOVNDC
- .I $P($G(^PSRX(PSOVIEN,"P",PSOVFILL,0)),"^",12)'="" S PSOVNX=$P(^(0),"^",12) Q
- .D DRUG
- Q PSOVNDC
- ;
- FORMAT ;format NDC
- S PSOVNDC=$G(PSOVNX)
- Q
- CMOP ;Find NDC for CMOP fill
- F PSOVY=0:0 S PSOVY=$O(^PSRX(PSOVIEN,4,PSOVY)) Q:'PSOVY D
- .I $P($G(^PSRX(PSOVIEN,4,PSOVY,0)),"^",3)=PSOVFILL,$P($G(^(0)),"^",8)'="" S PSOVNX=$P($G(^(0)),"^",8)
- Q
- DRUG ;Get NDC from Drug file
- S PSOVDRG=$P($G(^PSRX(PSOVIEN,0)),"^",6) I PSOVDRG,$P($G(^PSDRUG(+$G(PSOVDRG),2)),"^",4)'="" S PSOVNX=$P(^(2),"^",4)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOHDR 2252 printed Jan 18, 2025@03:30:43 Page 2
- PSOHDR ;BIR/RTR-Send order update message to HDR ;06/27/03
- +1 ;;7.0;OUTPATIENT PHARMACY;**181,205**;DEC 1997
- +2 ;External reference to PSDRUG supported by DBIA 221
- +3 ;External reference to VDEFQM supported by DBIA 4253
- +4 ;
- +5 ;PSOHDRTP = Type of message, PRES=fill, PPAR=partial, PREF=refill
- +6 ;PSOHDRNM = Internal entry number of order
- +7 ;
- EN(PSOHDRTP,PSOHDRNM) ; Entry point for VDEF calls
- +1 if '$GET(PSOHDRNM)
- QUIT
- +2 if $GET(PSOHDRTP)=""
- QUIT
- +3 IF $TEXT(QUEUE^VDEFQM)']""
- QUIT
- +4 IF '$DATA(^PSRX(PSOHDRNM,0))
- QUIT
- +5 ;Check for test patient
- +6 IF $TEXT(TESTPAT^VADPT)]""
- if $$TESTPAT^VADPT(+$PIECE($GET(^PSRX(PSOHDRNM,0)),"^",2))
- QUIT
- +7 NEW PSOHDRX,PSOHDRA,PSOHDRB
- +8 SET PSOHDRA=$SELECT(PSOHDRTP="PRES":"RDE^O11",PSOHDRTP="PPAR":"RDS^O13",PSOHDRTP="PREF":"RDS^O13",1:"")
- +9 if PSOHDRA=""
- QUIT
- +10 SET PSOHDRB="SUBTYPE="_PSOHDRTP_"^IEN="_PSOHDRNM
- +11 SET PSOHDRX=$$QUEUE^VDEFQM(PSOHDRA,PSOHDRB)
- +12 QUIT
- +13 ;
- +14 ;Return NDC number
- NDC(PSOVIEN,PSOVFILL,PSOVTYPE) ;
- +1 ;PSOVIEN = Internal prescription number
- +2 ;PSOVFILL = Fill Number
- +3 ;PSOVTYPE = "R" for refill, "P" for Partial
- +4 NEW PSOVNDC,PSOVNX,PSOVY,PSOVDRG
- +5 SET (PSOVNDC,PSOVNX)=""
- +6 IF $GET(PSOVIEN)'>0
- QUIT PSOVNDC
- +7 IF '$DATA(^PSRX(PSOVIEN,0))
- QUIT PSOVNDC
- +8 IF $GET(PSOVFILL)=""
- QUIT PSOVNDC
- +9 IF PSOVFILL=0
- Begin DoDot:1
- +10 DO CMOP
- IF PSOVNX'=""
- QUIT
- +11 ;I $P($G(^PSRX(PSOVIEN,"NDC")),"^")'="" S PSOVNX=$P(^("NDC"),"^") Q
- +12 IF $PIECE($GET(^PSRX(PSOVIEN,2)),"^",7)'=""
- SET PSOVNX=$PIECE(^(2),"^",7)
- QUIT
- +13 DO DRUG
- End DoDot:1
- if PSOVNX'=""
- DO FORMAT
- QUIT PSOVNDC
- +14 IF $GET(PSOVFILL)'>0
- QUIT PSOVNDC
- +15 IF $GET(PSOVTYPE)'="R"
- IF $GET(PSOVTYPE)'="P"
- QUIT PSOVNDC
- +16 IF PSOVTYPE="R"
- Begin DoDot:1
- +17 DO CMOP
- IF PSOVNX'=""
- QUIT
- +18 ;I $P($G(^PSRX(PSOVIEN,1,PSOVFILL,"NDC")),"^")'="" S PSOVNX=$P(^("NDC"),"^") Q
- +19 IF $PIECE($GET(^PSRX(PSOVIEN,1,PSOVFILL,1)),"^",3)'=""
- SET PSOVNX=$PIECE(^(1),"^",3)
- QUIT
- +20 DO DRUG
- End DoDot:1
- if PSOVNX'=""
- DO FORMAT
- QUIT PSOVNDC
- +21 IF PSOVTYPE="P"
- Begin DoDot:1
- +22 IF $PIECE($GET(^PSRX(PSOVIEN,"P",PSOVFILL,0)),"^",12)'=""
- SET PSOVNX=$PIECE(^(0),"^",12)
- QUIT
- +23 DO DRUG
- End DoDot:1
- if PSOVNX'=""
- DO FORMAT
- QUIT PSOVNDC
- +24 QUIT PSOVNDC
- +25 ;
- FORMAT ;format NDC
- +1 SET PSOVNDC=$GET(PSOVNX)
- +2 QUIT
- CMOP ;Find NDC for CMOP fill
- +1 FOR PSOVY=0:0
- SET PSOVY=$ORDER(^PSRX(PSOVIEN,4,PSOVY))
- if 'PSOVY
- QUIT
- Begin DoDot:1
- +2 IF $PIECE($GET(^PSRX(PSOVIEN,4,PSOVY,0)),"^",3)=PSOVFILL
- IF $PIECE($GET(^(0)),"^",8)'=""
- SET PSOVNX=$PIECE($GET(^(0)),"^",8)
- End DoDot:1
- +3 QUIT
- DRUG ;Get NDC from Drug file
- +1 SET PSOVDRG=$PIECE($GET(^PSRX(PSOVIEN,0)),"^",6)
- IF PSOVDRG
- IF $PIECE($GET(^PSDRUG(+$GET(PSOVDRG),2)),"^",4)'=""
- SET PSOVNX=$PIECE(^(2),"^",4)
- +2 QUIT