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

PSOPFSU0.m

Go to the documentation of this file. 
  1. PSOPFSU0 ;BIR/LE,AM - PFSS Get Account & Utilities ;08/09/93
  1.  ;;7.0;OUTPATIENT PHARMACY;**201,225**;DEC 1997;Build 29
  1.  ;External reference SWSTAT^IBBAPI supported by DBIA 4663
  1.  ;External reference GETACCT^IBBAPI supported by DBIA 4664
  1.  ;External reference ^DG(40.8,"AD" supported by DBIA 2817
  1.  Q
  1.  ;
  1. GACT(PSORXN,PSOREF) ;ENTRY POINT: Called from PSON52; PSOR52, PSORN52.  Get a PFSS acct ref
  1.  ; This routine is only called when the PFSS Switch is on.   
  1.  ;
  1.  N I,J,PSOPFSAC,PSOPV1,PSODG,PSOZCL,PSODFN,PSORX,PSOPV2,PSODIV
  1.  ;for sending to an external billing system, get data from file 52, build arrays for IBB API call
  1.  I PSOREF=0 D GACTOF
  1.  I PSOREF>0 D GACTRF
  1.  ;Get general Rx data fields
  1.  S PSODIV=$$MCDIV(PSORXN,PSOREF)
  1.  S PSODFN=$$GET1^DIQ(52,PSORXN,"2","I")
  1.  S PSOPV1(2)="O",PSOPV1(50)=PSORXN
  1.  S PSOPV1(3)=$$CHLOC()
  1.  Q:PSOPV1(3)="" 0  ;can't do GETACCT if CHARGE LOCATION is null; this is to be address in subsequent PFSS project phase
  1.  ;request the PFSS Acct Rev
  1.  S PSOPFSAC=$$GETACCT^IBBAPI(PSODFN,"","A04","GACT;PSOPFSU0",.PSOPV1,"","",.PSODG,.PSOZCL,PSODIV,"")
  1.  ;Store the PFS Acct Ref with speed in mind
  1.  Q:PSOPFSAC<1 ""
  1.  I PSOREF=0 S $P(^PSRX(PSORXN,"PFS"),"^")=PSOPFSAC
  1.  I PSOREF>0 S $P(^PSRX(PSORXN,1,PSOREF,"PFS"),"^")=PSOPFSAC
  1.  Q PSOPFSAC
  1.  ;
  1. GACTOF ;Get orig fill data
  1.  D GETS^DIQ(52,PSORXN,"4;22","I","PSORX")
  1.  S PSOPV1(7)=$G(PSORX(52,PSORXN_",",4,"I")),PSOPV1(44)=$G(PSORX(52,PSORXN_",",22,"I"))
  1.  D GOC
  1.  Q
  1.  ;
  1. GACTRF ;Called from GACT. Get refill data
  1.  D GETS^DIQ(52.1,PSOREF_","_PSORXN,".01;15","I","PSORX")
  1.  S PSOPV1(7)=$G(PSORX(52.1,PSOREF_","_PSORXN_",","15","I"))
  1.  S PSOPV1(44)=$G(PSORX(52.1,PSOREF_","_PSORXN_",",".01","I"))
  1.  D GOC
  1.  Q
  1.  ;
  1. CHLOC() ;FIND CHARGE LOCATION
  1.  N CHLOC,CL,PDIV
  1.  I PSOREF=0 S PDIV=$$GET1^DIQ(52,PSORXN,"20","I")   ;DIVISION
  1.  I PSOREF>0 S PDIV=$$GET1^DIQ(52.1,PSOREF_","_PSORXN_",","8","I")
  1.  S CHLOC=$$GET1^DIQ(59,PDIV,1007,"I") ;Charge location pointer
  1.  I CHLOC="" S CL="" D CLOK S:CL>0 CHLOC=CL
  1.  Q CHLOC
  1.  ;
  1. GOC ;Called from GACTOF and GACTRF.  Parse OP classifications and ICD's.  Don't send null values.
  1.  D GETS^DIQ(52,PSORXN,"52311*","I","PSORX")
  1.  F I=1:1 Q:'$D(PSORX(52.052311,I_","_PSORXN_","))  D
  1.  . S:PSORX(52.052311,I_","_PSORXN_",",".01","I")'="" PSODG(I,3)=PSORX(52.052311,I_","_PSORXN_",",".01","I"),PSODG(I,6)="W"
  1.  . I I=1 F J=1:1:8 Q:'$D(PSORX(52.052311,I_","_PSORXN_",",J,"I"))  D
  1.  . . S:PSORX(52.052311,I_","_PSORXN_",",J,"I")'="" PSOZCL(J,2)=J,PSOZCL(J,3)=PSORX(52.052311,I_","_PSORXN_",",J,"I")
  1.  S:'$D(PSOZCL) PSOZCL="" S:'$D(PSODG) PSODG=""
  1.  Q
  1.  ;
  1. RPH(PSORXN,PSOREF) ;API entry point
  1.  ;       Inputs:  PSORXN = prescription IEN, PSOREF = fill number
  1.  ;       Outputs: PSORPH = rel pharm IEN ^ user IEN who performed last activity or rel pharm iF no activity entries^
  1.  ;                   IB Service Section pointer from file 59
  1.  ;       Returns null values when the Rx is not released or the input values are invalid (i.e. "^^").
  1.  N I,II,IBSS,DIV,PSORPH,PSOEDPH,PSOA,PSORDT,PSOOK,PSOA,DATA
  1.  S PSOOK=$$CHKRX(PSORXN,PSOREF) Q:PSOOK'=1 "^^"
  1.  I 'PSOREF D GETS^DIQ(52,PSORXN,"20;23;31","I","DATA")
  1.  E  D GETS^DIQ(52.1,PSOREF_","_PSORXN,"4;8;17","I","DATA")
  1.  I PSOREF=0 D
  1.  . S PSORPH=+$G(DATA(52,PSORXN_",",23,"I")) S:PSORPH=0 PSORPH=""
  1.  . S DIV=+$G(DATA(52,PSORXN_",",20,"I"))
  1.  . S PSORDT=+$G(DATA(52,PSORXN_",",31,"I"))
  1.  I PSOREF>0 D
  1.  . S PSORPH=+$G(DATA(52.1,PSOREF_","_PSORXN_",",4,"I")) S:PSORPH=0 PSORPH=""
  1.  . S DIV=+$G(DATA(52.1,PSOREF_","_PSORXN_",",8,"I"))
  1.  . S PSORDT=+$G(DATA(52.1,PSOREF_","_PSORXN_",",17,"I"))
  1.  Q:PSORDT=0 "^^"
  1.  ;last activity - get last one with a user
  1.  I $D(^PSRX(PSORXN,"A",0)) S PSOA=$P(^PSRX(PSORXN,"A",0),"^",3) D
  1.  . F II=PSOA:-1:1 S PSOEDPH=$$GET1^DIQ(52.3,II_","_PSORXN_",",".03","I") Q:PSOEDPH'=""
  1.  ;get IB Service Section (requested by Ed Z. on 6/29/05)
  1.  S IBSS=$P($G(^PS(59,DIV,"IB")),"^")
  1.  S:'$G(PSOEDPH) PSOEDPH=PSORPH
  1.  S PSORPH=$G(PSORPH)_"^"_$G(PSOEDPH)_"^"_$G(IBSS)
  1.  Q PSORPH
  1.  ;
  1. CHKRX(PSORX,PSOF) ;validates Rx & fill. 0=not valid, 1=valid, 2=refill not valid
  1.  Q:PSORX=""!(PSOF="") 0
  1.  Q:'$D(^PSRX(PSORX)) 0
  1.  Q:PSOF>0&('$D(^PSRX(PSORX,1,PSOF))) 2
  1.  Q 1
  1.  ;
  1. MCDIV(RX,FILL) ;Get MC DIVISION from the Rx/Fill
  1.  N DIV,INST
  1.  ; outpatient division
  1.  I 'FILL S DIV=$$GET1^DIQ(52,RX,20,"I")
  1.  E  S DIV=$$GET1^DIQ(52.1,FILL_","_RX,8,"I")
  1.  Q:'DIV ""
  1.  ; related institution
  1.  S INST=$$GET1^DIQ(59,DIV,100,"I") Q:'INST ""
  1.  S DIV=$O(^DG(40.8,"AD",INST,0)) ; pointer to medical center division
  1.  Q DIV
  1.  ;
  1. CLOK ;
  1.  N I S I=0 F  S I=$O(^PS(59,I)) Q:'I!(CL>0)  D
  1.  . I $S('$D(^PS(59,I,"I")):1,'+$P(^("I"),"^"):1,DT'>+$P(^("I"),"^"):1,1:0) S CL=$P($G(^PS(59,I,"PFS")),"^")
  1.  Q
  1.  ;