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

ABSPOSB3.m

Go to the documentation of this file. 
  1. ABSPOSB3 ; IHS/FCS/DRS - FSI/ILC A/R interface ;      
  1.  ;;1.0;PHARMACY POINT OF SALE;;JUN 21, 2001
  1.  Q
  1. V681 ;EP - given VSTDFN
  1.  ; - add a V68.1 diagnosis if it doesn't already have one
  1.  N IEN
  1. V681A ;
  1.  Q:'$$V681IEN  ; V68.1 not on this system?! ; 03/26/2001
  1.  Q:$$HASV681
  1.  S IEN=$$ADDV681
  1.  ;W !,"Testing - in V681^"_$T(+0)," return value is ",IEN,!
  1.  I IEN<0 G V681A:$$IMPOSS^ABSPOSUE("FM","TRI","Failed to add diagnosis",,"V681",$T(+0))
  1.  Q
  1. HASV681() ; does VSTDFN already have a V68.1 among its diagnoses? ret true/false
  1.  N RET S RET=0
  1.  N A S A=0
  1.  F  S A=$O(^AUPNVPOV("AD",VSTDFN,A)) Q:'A  I $$ISV681(A) S RET=1 Q
  1.  Q RET
  1. ISV681(VPOVDFN)    ; is this a V68.1?
  1.  N X S X=$$V681IEN
  1.  Q ($P(^AUPNVPOV(VPOVDFN,0),U)=X)
  1. V681IEN()          Q $O(^ICD9("B","V68.1",0))
  1. ADDV681() ; given VSTDFN ; add a V68.1 diagnosis to the visit 
  1.  ; if you $$, it gives you back the IEN
  1. A681A L +^AUPNVPOV:300 I '$T G A681A:$$IMPOSS^ABSPOSUE("L","RIT","LOCK ^AUPNVPOV",,"ADDV681",$T(+0))
  1.  N DO,DD,DIC,DA,X,DINUM,Y,DTOUT,DUOUT,DLAYGO
  1.  ; DO killed so that Fileman doesn't assume leftover stuff
  1.  S DIC="^AUPNVPOV(",DIC(0)=""
  1.  S X=$$V681IEN
  1.  N DATA S DATA(.03)=VSTDFN
  1.  S DATA(.02)=$P(^AUPNVSIT(VSTDFN,0),U,5)
  1.  N I S DIC("DR")="" F I=.02,.03 D
  1.  . S DIC("DR")=DIC("DR")_I_"////"_DATA(I)_";"
  1.  S DIC("DR")=$E(DIC("DR"),1,$L(DIC("DR"))-1)
  1.  K DO,DD D FILE^DICN
  1.  L -^AUPNVPOV
  1.  Q:$Q +Y Q
  1. CLINIC ;EP - given VSTDFN - if it doesn't have one, give it one: pharmacy
  1.  I $$HASCLIN Q
  1.  N DIDEL,DTOUT,DIE,DA,DR
  1.  S DIE="^AUPNVSIT(",DA=VSTDFN,DR=".08////"_$$PHARMCLI
  1.  D ^DIE
  1.  Q
  1. HASCLIN() ; does VSTDFN already have a clinic?  return true or false 
  1.  Q $P(^AUPNVSIT(VSTDFN,0),U,8)
  1. PHARMCLI()         ; return IEN of PHARMACY clinic
  1.  Q $O(^DIC(40.7,"B","PHARMACY",""))
  1. PROVIDER() ;EP - given VSTDFN - and ^TMP($J,"VCPT",*)
  1.  ; if it doesn't have a provider, give it one
  1.  ; and make this the primary provider - he is the prescribing physician
  1.  ; on the first prescription
  1. P1 L +^AUPNVPRV:300 I '$T G P1:$$IMPOSS^ABSPOSUE("L","RIT","LOCK ^AUPNVPRV",,"PROVIDER",$T(+0))
  1.  I $O(^AUPNVPRV("AD",VSTDFN,0)) Q  ; already has a provider
  1.  N VCPT S VCPT=$O(^TMP($J,"VCPT",0)) ; take first VCPT
  1.  N RXI S RXI=$P($G(^ABSVCPT(9002301,VCPT,"SPEC")),U) Q:'RXI
  1.  ; PRESCRIPTION file points to file 200
  1.  ; follow the links from file 200 -> file 16 -> file 6
  1.  ; V PROVIDER file points to file 6
  1.  N PROV200 S PROV200=$P(^PSRX(RXI,0),U,4) Q:'PROV200  ; impossible?
  1.  N PROV16 S PROV16=$P($G(^VA(200,PROV200,0)),U,16) Q:'PROV16  ; imposs?
  1.  N PROV6 S PROV6=$P($G(^DIC(16,PROV16,"A6")),U)  Q:'PROV6  ; imposs?
  1.  N DO,DD,DIC,DA,X,DINUM,Y,DTOUT,DUOUT,DATA
  1.  ; leave DO undef
  1.  S DIC="^AUPNVPRV(",DIC(0)=""
  1.  S X=PROV6
  1.  S DATA(.02)=$P(^AUPNVSIT(VSTDFN,0),U,5)
  1.  S DATA(.03)=VSTDFN
  1.  S DATA(.04)="P"
  1.  N I S DIC("DR")="" F I=.02,.03,.04 D
  1.  . S DIC("DR")=DIC("DR")_I_"////"_DATA(I)
  1.  . I I'=.04 S DIC("DR")=DIC("DR")_";"
  1.  K DO,DD D FILE^DICN
  1.  L -^AUPNVPRV
  1.  Q:$Q +Y Q