Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: APSPELRX

APSPELRX.m

Go to the documentation of this file. 
  1. APSPELRX ;IHS/MSC/PLS - Electronic Pharmacy Support ;20-May-2013 17:28;PLS
  1.  ;;7.0;IHS PHARMACY MODIFICATIONS;**1006,1008,1009,1011,1016**;Sep 23, 2004;Build 74
  1. EN(RX,PHARM) ;EP
  1.  I $G(RX),$G(PHARM) D
  1.  .I $$SS(RX,PHARM) D
  1.  ..D BRDCAST(RX,PHARM)
  1.  .E  I $$FX(PHARM) D
  1.  ..D FAX(RX,PHARM)
  1.  .D PEI(RX)
  1.  Q
  1.  ; Called by APSPELRX PSCRIPT RPC
  1.  ; Returns prescription text
  1.  ; Input: ORIFN: IEN to Order File
  1.  ;        RXNUM: Prescription number (external)
  1.  ; Output: Array of text
  1. PSCRIPT(DATA,ORIFN,RXNUM) ;EP
  1.  N RX,RX1
  1.  S RX=$G(^OR(100,ORIFN,4))
  1.  S RX1=$O(^PSRX("B",RXNUM,0))
  1.  S DATA=$$TMPGBL^CIAVMRPC
  1.  ;I RX'=RX1 S @DATA@(1)="Incorrect information passed."
  1.  ;E  D
  1.  D CAPTURE^CIAUHFS("D FAXRX^APSPELRX",DATA)
  1.  Q
  1.  ;
  1. BRDCAST(RX,PHARM) ;EP
  1.  N ORIFN,RRIEN
  1.  S ORIFN=+$P($G(^PSRX(RX,"OR1")),U,2)
  1.  S RRIEN=$$VALUE^ORCSAVE2(ORIFN,"SSRREQIEN")
  1.  ; Check med class
  1.  ; If III-V
  1.  ;I $$DEACLS^APSPES2($$DEA^APSPES2($P($G(^PSRX(RX,0)),U,6)),"345") D  Q
  1.  ;.D DENY^APSPES3(ORIFN,RX,"RP","RP-A new prescription for a controlled substance is being faxed.",5)
  1.  ;.D FAX(RX,PHARM)
  1.  I RRIEN&($$ACT(RRIEN)'=3) D
  1.  .D ACCEPT^APSPES3(RX,ORIFN)
  1.  E  D
  1.  .Q:$$DEACLS^APSPES2($$DEA^APSPES2($P($G(^PSRX(RX,0)),U,6)),"2345")
  1.  .D NEWRX^APSPES1(RX)
  1.  Q
  1.  ;
  1. ACT(IEN) ;EP-
  1.  Q +$$GET1^DIQ(9009033.91,IEN,.08,"I")
  1.  ;
  1. FAX(RX,PHARM) ;EP
  1.  N FSRV,FFNUM,FCLNAM,FDT,FJOBNM,DATA,ARY,FAXNUM,POP
  1.  S FSRV=$$GET^XPAR("ALL","APSP AUTO RX FAX SERVER PATH")
  1.  Q:'$L(FSRV)
  1.  S FFNUM=$$GET^XPAR("ALL","APSP AUTO RX FAXED FROM NUMBER")
  1.  S FCLNAM=$$GET1^DIQ(9009033.9,PHARM,.01),FCLNAM=$TR(FCLNAM," ","_")
  1.  S FCLNAM=$TR(FCLNAM,"\/:*?<>","")
  1.  S FAXNUM=$$GET1^DIQ(9009033.9,PHARM,2.2)
  1.  S FDT=$$NOW^XLFDT(),FDT=$P(FDT,".")_"Z"_$P(FDT,".",2)
  1.  S FJOBNM=RX_"Z"_FDT
  1.  D OPEN^%ZISH("APSPFAX",FSRV,FJOBNM_"+"_FCLNAM_"@"_FAXNUM_".TXT","A")
  1.  Q:POP
  1.  U IO
  1.  D FAXRX
  1.  D CLOSE^%ZISH("APSPFAX")
  1.  S ARY("REASON")="X"
  1.  S ARY("TYPE")="T"
  1.  S ARY("COM")="Faxed to: "_FCLNAM_" @ "_FAXNUM
  1.  S ARY("RX REF")=0
  1.  D UPTLOG^APSPFNC2(.DATA,RX,0,.ARY)
  1.  Q
  1.  ; Write out prescription information
  1. FAXRX ;EP
  1.  ;TODO - ADD NOTE FOR CLASS III-V IF ORDER CONTAINS SSREFREQ
  1.  N DFN,PDIV,RX0,RX2,RX3,PDIV0,PSZIP,DASH
  1.  N PNM,ADDR,VA,DEASCH,HLOC,INST,PDIVZIP
  1.  N DRUG,DRUGNM,TRDNM,SIGNER
  1.  N VANUM,DEA,DXCODE,ORIFN
  1.  S RX0=^PSRX(RX,0)
  1.  S RX2=^PSRX(RX,2)
  1.  S RX3=^PSRX(RX,3)
  1.  ;
  1.  S DRUG=$P(RX0,U,6)
  1.  S DRUGNM=$$GET1^DIQ(50,DRUG,.01)
  1.  S TRDNM=$$GETDTNM(DRUG)
  1.  S DEASCH=$$GET1^DIQ(50,DRUG,3)
  1.  ;
  1.  S PDIV=$P(RX2,U,9)
  1.  S PDIV0=^PS(59,PDIV,0)
  1.  S PDIVZIP=$P(PDIV0,U,5)
  1.  ;
  1.  S DFN=$P(RX0,U,2)
  1.  S PNM=$$GET1^DIQ(2,DFN,.01)
  1.  D PID^VADPT
  1.  D PTADD(DFN,.ADDR)
  1.  S HLOC=$P(RX0,U,5)
  1.  S INST=+$$GET1^DIQ(44,HLOC,3)
  1.  S:'INST INST=DUZ(2)
  1.  ;
  1.  S SIGNER=+$P($G(^OR(100,+$P($G(^PSRX(RX,"OR1")),U,2),8,1,0)),U,5)
  1.  S DEA=$$GET1^DIQ(200,SIGNER,53.2,"I")  ;DEA #
  1.  S VANUM=$$GET1^DIQ(200,SIGNER,53.3,"I") ; VA #
  1.  S DXCODE=$$GET1^DIQ(52,RX,9999999.22)
  1.  S ORIFN=+$P($G(^PSRX(RX,"OR1")),U,2)
  1.  ;
  1.  S $P(DASH,"-",63)="-"
  1.  ; Output Address
  1.  ; Pharmacy Division Mailing Info
  1.  ;W $P(PDIV0,U)
  1.  ;W !,$P(PDIV0,U,7)_","_$$GET1^DIQ(5,$P(PDIV0,U,8),1)_"  "_$S(PDIVZIP["-":PDIVZIP,1:$E(PDIVZIP,1,5)_$S($E(PDIVZIP,6,9)]"":"-"_$E(PDIVZIP,6,9),1:""))
  1.  ;W !,$P(PDIV0,U,3)_"-"_$P(PDIV0,U,4)
  1.  ; Institution Mailing Info
  1.  W $$GET1^DIQ(4,INST,.01)
  1.  W !,$$GET1^DIQ(4,INST,1.01)  ;Street Address 1
  1.  W !,$$GET1^DIQ(4,INST,1.03)_", "_$$GET1^DIQ(4,INST,.02)_"  "_$$GET1^DIQ(4,INST,1.04)
  1.  W !,$$GET1^DIQ(9999999.06,INST,.13)
  1.  W !!,DASH,!
  1.  ; Output Patient Info
  1.  W !,"Rx for: "_PNM_"  "_VA("PID")_"     DOB:"_$$UP^XLFSTR($$FMTE^XLFDT($$GET1^DIQ(2,DFN,.03,"I")))  ;Patch 1009
  1.  W !,?8,ADDR(1)
  1.  W !,?8,ADDR(2)
  1.  W:$L(ADDR(3)) !,?8,ADDR(3)
  1.  W !,?8,ADDR(33)
  1.  W !,DASH,!
  1.  W !,DRUGNM
  1.  W:$L(TRDNM) !,"Also known as: "_TRDNM ; todo - make parameter or field to control display
  1.  W !!,"Pharmacy may choose strength(s) of drug to meet requirements of directions."
  1.  W !
  1.  D SIG(RX)
  1.  W !!,"   Dispense: ",$P(RX0,U,7)_"  "_$P($G(^PSDRUG(DRUG,660)),U,8)
  1.  W "      Pharmacy to adjust qty for # of days."
  1.  W !,"Days Supply: ",$P(RX0,U,8)
  1.  W !,"  Refill(s): ",$P(RX0,U,9)
  1.  W !," Issue Date: ",$$GET1^DIQ(52,RX,1)
  1.  W !,"  Indicator: ",$$GET1^DIQ(52,RX,9999999.21)_$S($L(DXCODE):"  ("_DXCODE_")",1:"")
  1.  ;W !,?8,"DOB: ",$$UP^XLFSTR($$FMTE^XLFDT($$GET1^DIQ(2,DFN,.03,"I")))  ;Patch 1009
  1.  W !
  1.  D PRC(RX)
  1.  W !
  1.  W !,"Signed: /ES/"_$$GET1^DIQ(200,SIGNER,.01)_"   "_VANUM_$S(+DEASCH&(DEASCH<6):"   "_DEA,1:"")  ;DEA PRINTS FOR SCH 1-5
  1.  W:$$SUBS(RX) !!,"DISPENSE AS WRITTEN"
  1.  I $$DEACLS^APSPES2($$DEA^APSPES2($P(RX0,U,6)),"345") D
  1.  .Q:'$$VALUE^ORCSAVE2(+$P($G(^PSRX(RX,"OR1")),U,2),"SSRREQIEN")  ; Must be in response to a refill request
  1.  .W !,"NOTE: This schedule III-V prescription is being faxed."
  1.  ;
  1.  W:$L($G(FFNUM)) !!,"Faxed from: ",FFNUM," ON ",$$FMTE^XLFDT($$NOW^XLFDT)
  1.  Q
  1. SS(RXIEN,PIEN) ;EP
  1.  Q:'$G(RXIEN)!'$G(PIEN) 0
  1.  N ND7,SVCL,SDT,EDT,NOW,SPI
  1.  S SPI=$$SPI^APSPES1(+$$GET1^DIQ(52,RXIEN,4,"I"))
  1.  S NOW=$$NOW^XLFDT
  1.  S ND7=$G(^APSPOPHM(PIEN,7))
  1.  S SVCL=$P($G(^APSPOPHM(PIEN,0)),U,5)  ;Service Level
  1.  S SDT=$P(ND7,U)
  1.  S EDT=$P(ND7,U,2)
  1.  Q $L(SPI)&(SVCL#2)&(NOW>SDT)&(NOW<EDT)
  1.  ; Called by DC^ORWDXA when unreleased order is discontinued (denied)
  1.  ; Input: ORID - ^OR(100 ien
  1. DC(ORID) ; EP -
  1.  ; Send denial HL7 message
  1.  D DENY^APSPES3(ORID)
  1.  Q
  1.  ; Return fax number or flag indicating a fax number is present
  1. FX(PIEN,FLG) ;EP
  1.  Q:'$G(PIEN) 0
  1.  N FNUM
  1.  S FNUM=$$GET1^DIQ(9009033.9,PIEN,2.2)
  1.  Q $S($G(FLG):FNUM,1:''FNUM)
  1.  ; Return Trade Name Synonym for given drug (if defined)
  1. GETDTNM(DIEN) ;EP
  1.  N LP,FLG,RET
  1.  S LP=0,RET=""
  1.  S FLG=0
  1.  F  S LP=$O(^PSDRUG(DIEN,1,LP)) Q:'LP!(FLG)  D
  1.  .S:$P(^PSDRUG(DIEN,1,LP,0),U,3)=0 RET=$P(^(0),U),FLG=1
  1.  Q RET
  1.  ; Output Provider Comments
  1. PRC(RX) ;EP
  1.  K ^UTILITY($J,"W")
  1.  N DIWL,DIWR,DIWF,LP,X
  1.  S DIWL=0,DIWR=48,DIWF=""
  1.  S LP=0 F  S LP=$O(^PSRX(RX,"PRC",LP)) Q:'LP  D
  1.  .I $D(^(LP,0)) S X=^(0) D ^DIWP
  1.  I $D(^UTILITY($J,"W")) D
  1.  .W "MD Comments:"
  1.  .S LP=0 F  S LP=$O(^UTILITY($J,"W",DIWL,LP)) Q:'LP  W ?13,^(LP,0),!
  1.  K ^UTILITY($J,"W")
  1.  Q
  1.  ; Output SIG
  1. SIG(RX) ;EP
  1.  N LP
  1.  S LP=0 F  S LP=$O(^PSRX(RX,"SIG1",LP)) Q:'LP  D
  1.  .W !,^PSRX(RX,"SIG1",LP,0)
  1.  Q
  1.  ; Collect patient address information
  1. PTADD(DFN,ARY) ;EP
  1.  N VADM,VAEL,VAERR,VAPA
  1.  D 6^VADPT
  1.  S ARY(1)=VAPA(1)
  1.  S ARY(2)=VAPA(2),ARY(3)=VAPA(3),ARY(4)=""
  1.  I VAPA(2)'="",VAPA(3)="" S ARY(2)=VAPA(2),ARY(3)=ARY(4),ARY(4)=""
  1.  I VAPA(2)="",VAPA(3)'="" S ARY(2)=VAPA(3),ARY(3)=VAPA(4),ARY(4)=""
  1.  S ARY(33)=$G(VAPA(4))_", "_$P($G(VAPA(5)),"^",2)_"  "_$S($G(VAPA(11))]"":$P($G(VAPA(11)),"^",2),1:$G(VAPA(6)))
  1.  Q
  1.  ; Check Substitution Flag
  1. SUBS(RX) ;EP -
  1.  N VAL
  1.  S VAL=$$GET1^DIQ(52,RX,9999999.25,"I")
  1.  Q $S((VAL=1)!(VAL=7):1,1:0)
  1.  ; Populate the Pharmacy External Interface File
  1. PEI(RX) ; EP
  1.  N FDA,ERR,IENS
  1.  Q:'$G(RX)
  1.  S IENS="+1,"
  1.  S FDA(52.51,IENS,.01)=RX
  1.  S FDA(52.51,IENS,2)=$P(^PSRX(RX,0),U,2)  ; Patient
  1.  S FDA(52.51,IENS,3)=$$NOW^XLFDT()
  1.  S FDA(52.51,IENS,4)=$P(^PSRX(RX,0),U,4)  ; Provider
  1.  S FDA(52.51,IENS,8)="F"
  1.  S FDA(52.51,IENS,9)=0
  1.  S FDA(52.51,IENS,13)="E-PRESCRIBING MESSAGE"
  1.  S FDA(52.51,IENS,14)=2
  1.  D UPDATE^DIE(,"FDA",,"ERR")
  1.  Q