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

APSPESG1.m

Go to the documentation of this file. 
  1. APSPESG1 ;IHS/MSC/MGH - Display entries from refill queue in APSP REFILL REQUEST file ;02-Jul-2013 14:24;DU
  1.  ;;7.0;IHS PHARMACY MODIFICATIONS;**1016**;Sep 23,2004;Build 74
  1.  ;==================================================================
  1. DETAIL(DATA,IEN) ;EP for RPC call
  1.  N APSPPID,APSPDG1,APSPRXE,APSPRXO,APSPORC,STR,UNITS,ROUTE,NOUN,USCHDUR,MEDUNITS,SIGNAT,DONE,SCHITEM,SCHUPD,INTERVAL,SCHARY,TOTDUR,CONJ
  1.  N HLECH,DEL,APSPMSH,APSPRXR,APSPRXD,DUR,SIGDAT,ITEM,MSGID,I
  1.  S HLECH=$P($G(APSPMSH),"|",2) I '$L(HLECH) S HLECH="^~\&"
  1.  F I=1:1:4 D
  1.  .S HLECH(I)=$E(HLECH,I)
  1.  S MSGID=$$GET1^DIQ(9009033.91,IEN,.01,"E"),HLMSG=$$GHLDAT(IEN)
  1.  S DEL="|"
  1.  D SHLVARS^APSPESG
  1.  D HL7DATA(.HL7,IEN)
  1.  D MAPDATA(.MAP,IEN)
  1.  ;Put together dosing information
  1.  S STR=$P($G(APSPRXO),DEL,3),UNITS=$P($P($G(APSPRXO),DEL,5),HLECH(1),2),ROUTE=$P($G(APSPRXR),DEL,2)
  1.  S NOUN=$P($G(APSPRXO),DEL,6) I $L(NOUN) S NOUN=$O(^APSPNCP(9009033.7,"B",NOUN,0)),NOUN=$$GET1^DIQ(9009033.7,NOUN,1,"E")
  1.  S USCHDUR=$P($G(APSPORC),DEL,8),MEDUNITS=$P($P($G(APSPRXO),DEL,20),HLECH(1),2)
  1.  S SIGDAT=$P($P(APSPRXO,DEL,8),"^",2)
  1.  S DONE=0
  1.  F I=1:1 D  Q:DONE
  1.  .S SCHITEM=$P(USCHDUR,HLECH(2),I)
  1.  .I '$L(SCHITEM) S DONE=1 Q
  1.  .S SCHUPD=$P(SCHITEM,HLECH(1)) I 'SCHUPD S SCHUPD=1
  1.  .S INTERVAL=$P(SCHITEM,HLECH(1),2),DUR=$P(SCHITEM,HLECH(1),3),CONJ=$P(SCHITEM,HLECH(1),9)
  1.  .S SCHARY(I)=SCHUPD_U_INTERVAL_U_DUR_U_CONJ
  1.  .S TOTDUR=$G(TOTDUR)+DUR
  1.  S DATA=$$TMPGBL^CIAVMRPC
  1.  D CAPTURE^CIAUHFS("D DISPHL7^APSPESG1(.HL7,.MAP,STR,UNITS,ROUTE,NOUN,.SCHARY,MEDUNITS,SIGDAT)",DATA)
  1.  Q
  1. MAPDATA(MAP,IEN) ; Get the data that was mapped
  1.  K MAP
  1.  N PAT,DPT,DOB,SEX,HRCN,Y,PHARM,PROV
  1.  S (PAT,DPT,DOB,SEX,HRCN,PROV)=""
  1.  S DPT=$$GET1^DIQ(9009033.91,IEN,1.2,"I")
  1.  I DPT'="" D
  1.  .S PAT=$$GET1^DIQ(2,DPT,.01,"E")
  1.  .S DOB=$$GET1^DIQ(2,DPT,.03,"I")
  1.  .S Y=DOB D DD^%DT S DOB=Y
  1.  .S SEX=$$GET1^DIQ(2,DPT,.02,"E")
  1.  .S HRCN=$$HRCN(DPT,$G(DUZ(2)))
  1.  .S MAP("PADDR")=$$PTADDR(DPT)
  1.  .S MAP("PPHONE")=$$FMTPHN^APSPES2($$GET1^DIQ(2,DPT,.131,"I"))
  1.  E  S PAT="**UNKNOWN**"
  1.  S MAP("PAT")=PAT
  1.  S MAP("EXT")="DOB: "_DOB_" SEX: "_SEX_" HRCN: "_HRCN
  1.  S PHARM=$$GET1^DIQ(9009033.91,IEN,1.7,"I")
  1.  S MAP("PHARM")=$$GET1^DIQ(9009033.91,IEN,1.7,"E")_" Ph: "_$$FMTPHN^APSPES2($$GET1^DIQ(9009033.9,PHARM,2.1,"I"))
  1.  S MAP("PHARMA")=$$PADDR(PHARM)
  1.  S MAP("SUP")=$$GET1^DIQ(9009033.91,IEN,1.5,"E")
  1.  S MAP("QTY")=$$GET1^DIQ(9009033.91,IEN,1.4,"E")
  1.  S MAP("TIME")=$$GET1^DIQ(9009033.91,IEN,0.4,"E")
  1.  S MAP("DAW")=$$GET1^DIQ(9009033.91,IEN,1.12,"E")
  1.  S PROV=$$GET1^DIQ(9009033.91,IEN,1.3,"I")
  1.  S MAP("PROV")=$$GET1^DIQ(9009033.91,IEN,1.3,"E")
  1.  S MAP("OFF")=$$FMTPHN^APSPES2($$GET1^DIQ(200,PROV,.132,"I"))
  1.  S MAP("PROVAD")=$$PROVAD(PROV)
  1.  S MAP("DRUG")=$$GET1^DIQ(9009033.91,IEN,1.1,"E")
  1.  S MAP("SIG")=$$GET1^DIQ(9009033.913,"1,"_IEN_",",.01)
  1.  ;S MAP("NOTES")=$$GET1^DIQ(9009033.91,IEN,4.1)
  1.  S MAP("DX")=$$GET1^DIQ(9009033.91,IEN,7.1)
  1.  S MAP("REFIL")=$$GET1^DIQ(9009033.91,IEN,1.9)
  1.  Q
  1. HL7DATA(HL7,IEN) ;Get the data from the HL7 file
  1.  N PAT,DOB,SEX,HRCN,PROV,PROVDAT,SUB,DSUB,DCODE,DRG,DCODEQ
  1.  K HL7
  1.  S PAT=$$PATNAME^APSPESLP(APSPPID) I '$L(PAT) S PAT="**UNKNOWN**"
  1.  S HRCN=$P($P(APSPPID,DEL,4),HLECH(1),1)
  1.  S DOB=$$FMTE^XLFDT($$FMDATE^HLFNC($P(APSPPID,DEL,8)))
  1.  S SEX=$P(APSPPID,DEL,9)
  1.  S HL7("PAT")=PAT
  1.  S HL7("EXT")="DOB: "_DOB_" SEX: "_SEX_" HRCN: "_HRCN
  1.  S HL7("PPHONE")=$$FMTPHN^APSPES2($P($P(APSPPID,DEL,14),HLECH(1),1))
  1.  S HL7("PADD")=$$FMTADD($P(APSPPID,DEL,12))
  1.  S HL7("PHARM")=$P($P(APSPRXE,DEL,41),HLECH(1),2)_" Ph "_$$FMTPHN^APSPES2($P($P(APSPRXE,DEL,46),HLECH(1),1))
  1.  S HL7("DRUG")=$P($P(APSPRXO,DEL,2),HLECH(1),2)
  1.  S HL7("SUP")=$P($P($P(APSPORC,DEL,8),HLECH(1),3),"~",1)
  1.  S HL7("QTY")=$P($P(APSPRXO,DEL,12),HLECH(1),1)
  1.  S HL7("SIG")=$P($P(APSPRXO,DEL,8),HLECH(1),2)
  1.  ;S HL7("INST")=$P($P(APSPRXO,DEL,7),HLECH(1),2)
  1.  S HL7("NOTE")=$P($P(APSPRXO,DEL,7),HLECH(1),2)
  1.  ;S HL7("NTE")=$P($P(APSPRXO,DEL,7),HLECH(1),2)
  1.  S HL7("REFIL")=$P($P(APSPRXO,DEL,14),HLECH(1),1)
  1.  S SUB=$P(APSPRXO,DEL,10)
  1.  S HL7("SUB")=$S(SUB="G":"Allow Generics",SUB="N":"Dispense as Written",1:"Allow Theraputic Substitutions")
  1.  S PROVDAT=$P(APSPORC,DEL,13),PROV=$P(PROVDAT,HLECH(1),2)_","_$P(PROVDAT,HLECH(1),3)
  1.  S HL7("PROV")=PROV
  1.  S HL7("PRADD")=$$FMTADD($P(APSPORC,DEL,25))
  1.  S HL7("PRPH")=$$FMTPHN^APSPES2($P($P(APSPORC,DEL,24),HLECH(1),1))
  1.  S HL7("ISSUE")=$$FMTE^XLFDT($$FMDATE^HLFNC($P($P(APSPORC,DEL,10),HLECH(1),1)),"5DZ0")
  1.  S HL7("PHADD")=$$FMTADD($P(APSPRXE,DEL,42))
  1.  S HL7("LFIL")=$$FMTE^XLFDT($$FMDATE^HLFNC($P($P(APSPORC,DEL,27),HLECH(1),1)),"5DZ0")
  1.  S DCODE=$P($P(APSPRXD,DEL,3),HLECH(1),1)
  1.  S DRG=$P($P(APSPRXD,DEL,3),HLECH(1),2)
  1.  S DCODEQ=$P($P(APSPRXD,DEL,3),HLECH(1),3)
  1.  S HL7("DDRG")=DRG_$S($L(DCODE):" ("_DCODEQ_":"_DCODE_")",1:"")
  1.  S HL7("DSIG")=$P($P(APSPRXD,DEL,10),HLECH(1),1)
  1.  S HL7("DSUP")=$P($P(APSPRXD,DEL,23),HLECH(1),1)
  1.  S HL7("DQTY")=$P($P(APSPRXD,DEL,5),HLECH(1),1)
  1.  S HL7("DREFILL")=$P($P(APSPRXD,DEL,9),HLECH(1),1)
  1.  S HL7("DNOTE")=$P($P(APSPRXD,DEL,16),HLECH(1),2)
  1.  S HL7("DDATE")=$$FMTE^XLFDT($$FMDATE^HLFNC($P($P(APSPRXD,DEL,4),HLECH(1),1)),"5DZ0")
  1.  S DSUB=$P(APSPRXO,DEL,10)
  1.  S HL7("DSUB")=$S(DSUB="G":"Allow Generics",DSUB="N":"Dispense as Written",1:"Allow Theraputic Substitutions")
  1.  I APSPDG1'="" D
  1.  .S HL7("DX")=$P($P(APSPDG1,DEL,4),HLECH(1),U,1)_" "_$P($P(APSPDG1,DEL,4),HLECH(1),2)
  1.  Q
  1. DISPHL7(HL7,MAP,STR,UNITS,ROUTE,NOUN,SCHARY,MEDUNITS,SIG,ARY) ; Display HL7 data
  1.  N LINE,K
  1.  W !!
  1.  S $P(LINE,"-",80)=""
  1.  W LINE
  1.  W !,"  DISPLAYING incoming HL7 data:",!
  1.  W !,"        Patient: "_$G(HL7("PAT"))
  1.  W !,"        Pt Data: "_$G(HL7("EXT"))
  1.  W !,"     Pt Address: "_$G(HL7("PADD"))
  1.  W !,"       Pt Phone: "_$G(HL7("PPHONE"))
  1.  W !,"       Provider: "_$G(HL7("PROV"))_" Ph: "_$G(HL7("PRPH"))
  1.  W !,"   Prov Address: "_$G(HL7("PRADD"))
  1.  W !!,"     Medication: "_$G(HL7("DRUG"))
  1.  W !,"            SIG: "_$G(HL7("SIG"))
  1.  ;W !,"       Pt Instr: "_$G(HL7("INST"))
  1.  W !,"         Supply: "_$G(HL7("SUP"))
  1.  W !,"       Quantity: "_$G(HL7("QTY"))
  1.  W !,"        Refills: "_$G(HL7("REFIL"))
  1.  W !,"             Dx: "_$G(HL7("DX"))
  1.  W !,"            Sub: "_$G(HL7("SUB"))
  1.  W !,"       Pharmacy: "_$G(HL7("PHARM"))
  1.  W !,"     Ph Address: "_$G(HL7("PHADD"))
  1.  W !," Notes to Pharm: "_$G(HL7("NOTE"))
  1.  W !,"       Issue Dt: "_$G(HL7("ISSUE"))
  1.  W !!,"  DISPENSED Drug Information",!
  1.  W !," Dispensed Drug: "_$G(HL7("DDRG"))
  1.  W !,"            SIG: "_$G(HL7("DSIG"))
  1.  W !,"         Supply: "_$G(HL7("DSUP"))
  1.  W !,"       Quantity: "_$G(HL7("DQTY"))
  1.  W !,"        Refills: "_$G(HL7("DREFILL"))
  1.  W !,"            Sub: "_$G(HL7("DSUB"))
  1.  W !,"   Written Date: "_$G(HL7("DDATE"))
  1.  W !,"  Notes to Prov: "_$G(HL7("DNOTE"))
  1.  W !,""
  1.  W LINE
  1.  W !,"   MAPPED DATA:",!
  1.  W !,"       Patient: "_$G(MAP("PAT"))
  1.  W !,"       Pt Data: "_$G(MAP("EXT"))
  1.  W !,"       Address: "_$G(MAP("PADDR"))
  1.  W !,"      Pt Phone: "_$G(MAP("PPHONE"))
  1.  W !,"      Provider: "_$G(MAP("PROV"))_" Ph: "_$G(MAP("OFF"))
  1.  W !,"  Prov Address: "_$G(MAP("PROVAD"))
  1.  W !!,"    Medication: "_$G(MAP("DRUG"))
  1.  W !,"           SIG: "_$G(MAP("SIG"))
  1.  W !,"        Supply: "_$G(MAP("SUP"))
  1.  W !,"      Quantity: "_$G(MAP("QTY"))
  1.  W !,"       Refills: "_$G(MAP("REFIL"))
  1.  W !,"            Dx: "_$G(MAP("DX"))
  1.  W !,"           Sub: "_$G(MAP("DAW"))
  1.  W !,"      Pharmacy: "_$G(MAP("PHARM"))
  1.  W !,"    Ph Address: "_$G(MAP("PHARMA"))
  1.  ;W !,"        Notes: "_$G(MAP("NOTES"))
  1.  W !!,"  Dosing information: (multiple line items indicates complex dosing)"
  1.  W:$D(SCHARY) !,?3,"Units/Dose",?15,"Interval",?25,"Duration",?35,"Conjunction"
  1.  F K=1:1 D  Q:'$D(SCHARY(K))
  1.  .I $D(SCHARY(K)) W !,?5,$P(SCHARY(K),U),?15,$P(SCHARY(K),U,2),?25,$P(SCHARY(K),U,3),?35,$P(SCHARY(K),U,4)
  1.  W !,LINE
  1.  Q
  1.  ;
  1. HRCN(DFN,SITE) ;EP; IHS/MSC/MGH return chart number
  1.  Q $P($G(^AUPNPAT(DFN,41,SITE,0)),U,2)
  1. GHLDAT(IEN) ; Get HL7 message data from APSP REFILL REQUEST FILE
  1.  N HLMSG
  1.  S HLMSG=$$GET1^DIQ(9009033.91,IEN,5,"","HLDATA")
  1.  Q HLMSG
  1.  ;
  1. CHKDEF(IEN,TEXT) ;
  1.  N FOUND,X
  1.  S FOUND=0
  1.  S X=0 F  S X=$O(^APSPRREQ(ITEM,3,X)) Q:'X  D
  1.  .I $G(^APSPRREQ(ITEM,3,X,0))=TEXT S FOUND=1
  1.  Q FOUND
  1. FMTADD(FIELD) ;
  1.  ;Format the incoming address in HL7 file
  1.  N ADDR,STR,CITY,ST,ZIP
  1.  S ADDR=""
  1.  I FIELD="" Q ADDR
  1.  S STR=$P(FIELD,HLECH(1),1)
  1.  S CITY=$P(FIELD,HLECH(1),3)
  1.  S ST=$P(FIELD,HLECH(1),4)
  1.  S ZIP=$P(FIELD,HLECH(1),5)
  1.  S ADDR=STR_" "_CITY_", "_ST_" "_ZIP
  1.  Q ADDR
  1. PADDR(IEN) ;
  1.  ;format pharmacy address from APSP Pharmacy file
  1.  N ADDR,STR,STR2,CITY,ST,ZIP
  1.  S ADDR=""
  1.  S STR=$$GET1^DIQ(9009033.9,IEN,1.1,"E")
  1.  S STR2=$$GET1^DIQ(9009033.9,IEN,1.2,"E")
  1.  S CITY=$$GET1^DIQ(9009033.9,IEN,1.3,"E")
  1.  S ST=$$GET1^DIQ(9009033.9,IEN,1.4,"E")
  1.  S ZIP=$$GET1^DIQ(9009033.9,IEN,1.5,"E")
  1.  I STR2'="" S STR=STR_" "_STR2
  1.  S ADDR=STR_" "_CITY_" ,"_ST_" "_ZIP
  1.  Q ADDR
  1. PTADDR(DFN) ;Format patient address
  1.  N ADDR,STR,STR2,CITY,ST,ZIP
  1.  S ADDR=""
  1.  S STR=$$GET1^DIQ(2,DFN,.111,"E")
  1.  S STR2=$$GET1^DIQ(2,DFN,.112,"E")
  1.  S CITY=$$GET1^DIQ(2,DFN,.114,"E")
  1.  S ST=$$GET1^DIQ(2,DFN,.115,"E")
  1.  S ZIP=$$GET1^DIQ(2,DFN,.116,"E")
  1.  I STR2'="" S STR=STR_" "_STR2
  1.  S ADDR=STR_" "_CITY_" ,"_ST_" "_ZIP
  1.  Q ADDR
  1. PROVAD(PROV) ;Format provider address
  1.  N ADDR,STR,STR2,CITY,ST,ZIP
  1.  S ADDR=""
  1.  S STR=$$GET1^DIQ(200,PROV,.111,"E")
  1.  S STR2=$$GET1^DIQ(200,PROV,.112,"E")
  1.  S CITY=$$GET1^DIQ(200,PROV,.114,"E")
  1.  S ST=$$GET1^DIQ(200,PROV,.115,"E")
  1.  S ZIP=$$GET1^DIQ(200,PROV,.116,"E")
  1.  I STR2'="" S STR=STR_" "_STR2
  1.  S ADDR=STR_" "_CITY_" ,"_ST_" "_ZIP
  1.  Q ADDR