- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOPFSU0.m
r613 r623 1 PSOPFSU0 2 ;;7.0;OUTPATIENT PHARMACY;**201,225**;DEC 1997;Build 29 3 4 5 6 7 8 GACT(PSORXN,PSOREF) 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 GACTOF 30 31 32 33 34 35 GACTRF 36 37 38 39 40 41 42 CHLOC() 43 44 45 46 47 48 49 50 GOC 51 52 53 54 . I I=1 F J=1:1:8Q:'$D(PSORX(52.052311,I_","_PSORXN_",",J,"I")) D55 56 57 58 59 RPH(PSORXN,PSOREF) 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 CHKRX(PSORX,PSOF) 87 88 89 90 91 92 MCDIV(RX,FILL) 93 94 95 96 97 98 99 100 101 102 103 CLOK 104 105 106 107 1 PSOPFSU0 ;BIR/LE,AM - PFSS Get Account & Utilities ;08/09/93 2 ;;7.0;OUTPATIENT PHARMACY;**201**;DEC 1997 3 ;External reference SWSTAT^IBBAPI supported by DBIA 4663 4 ;External reference GETACCT^IBBAPI supported by DBIA 4664 5 ;External reference ^DG(40.8,"AD" supported by DBIA 2817 6 Q 7 ; 8 GACT(PSORXN,PSOREF) ;ENTRY POINT: Called from PSON52; PSOR52, PSORN52. Get a PFSS acct ref 9 ; This routine is only called when the PFSS Switch is on. 10 ; 11 N I,J,PSOPFSAC,PSOPV1,PSODG,PSOZCL,PSODFN,PSORX,PSOPV2,PSODIV 12 ;for sending to an external billing system, get data from file 52, build arrays for IBB API call 13 I PSOREF=0 D GACTOF 14 I PSOREF>0 D GACTRF 15 ;Get general Rx data fields 16 S PSODIV=$$MCDIV(PSORXN,PSOREF) 17 S PSODFN=$$GET1^DIQ(52,PSORXN,"2","I") 18 S PSOPV1(2)="O",PSOPV1(50)=PSORXN 19 S PSOPV1(3)=$$CHLOC() 20 Q:PSOPV1(3)="" 0 ;can't do GETACCT if CHARGE LOCATION is null; this is to be address in subsequent PFSS project phase 21 ;request the PFSS Acct Rev 22 S PSOPFSAC=$$GETACCT^IBBAPI(PSODFN,"","A04","GACT;PSOPFSU0",.PSOPV1,"","",.PSODG,.PSOZCL,PSODIV,"") 23 ;Store the PFS Acct Ref with speed in mind 24 Q:PSOPFSAC<1 "" 25 I PSOREF=0 S $P(^PSRX(PSORXN,"PFS"),"^")=PSOPFSAC 26 I PSOREF>0 S $P(^PSRX(PSORXN,1,PSOREF,"PFS"),"^")=PSOPFSAC 27 Q PSOPFSAC 28 ; 29 GACTOF ;Get orig fill data 30 D GETS^DIQ(52,PSORXN,"4;22","I","PSORX") 31 S PSOPV1(7)=$G(PSORX(52,PSORXN_",",4,"I")),PSOPV1(44)=$G(PSORX(52,PSORXN_",",22,"I")) 32 D GOC 33 Q 34 ; 35 GACTRF ;Called from GACT. Get refill data 36 D GETS^DIQ(52.1,PSOREF_","_PSORXN,".01;15","I","PSORX") 37 S PSOPV1(7)=$G(PSORX(52.1,PSOREF_","_PSORXN_",","15","I")) 38 S PSOPV1(44)=$G(PSORX(52.1,PSOREF_","_PSORXN_",",".01","I")) 39 D GOC 40 Q 41 ; 42 CHLOC() ;FIND CHARGE LOCATION 43 N CHLOC,CL,PDIV 44 I PSOREF=0 S PDIV=$$GET1^DIQ(52,PSORXN,"20","I") ;DIVISION 45 I PSOREF>0 S PDIV=$$GET1^DIQ(52.1,PSOREF_","_PSORXN_",","8","I") 46 S CHLOC=$$GET1^DIQ(59,PDIV,1007,"I") ;Charge location pointer 47 I CHLOC="" S CL="" D CLOK S:CL>0 CHLOC=CL 48 Q CHLOC 49 ; 50 GOC ;Called from GACTOF and GACTRF. Parse OP classifications and ICD's. Don't send null values. 51 D GETS^DIQ(52,PSORXN,"52311*","I","PSORX") 52 F I=1:1 Q:'$D(PSORX(52.052311,I_","_PSORXN_",")) D 53 . S:PSORX(52.052311,I_","_PSORXN_",",".01","I")'="" PSODG(I,3)=PSORX(52.052311,I_","_PSORXN_",",".01","I"),PSODG(I,6)="W" 54 . I I=1 F J=1:1:7 Q:'$D(PSORX(52.052311,I_","_PSORXN_",",J,"I")) D 55 . . S:PSORX(52.052311,I_","_PSORXN_",",J,"I")'="" PSOZCL(J,2)=J,PSOZCL(J,3)=PSORX(52.052311,I_","_PSORXN_",",J,"I") 56 S:'$D(PSOZCL) PSOZCL="" S:'$D(PSODG) PSODG="" 57 Q 58 ; 59 RPH(PSORXN,PSOREF) ;API entry point 60 ; Inputs: PSORXN = prescription IEN, PSOREF = fill number 61 ; Outputs: PSORPH = rel pharm IEN ^ user IEN who performed last activity or rel pharm iF no activity entries^ 62 ; IB Service Section pointer from file 59 63 ; Returns null values when the Rx is not released or the input values are invalid (i.e. "^^"). 64 N I,II,IBSS,DIV,PSORPH,PSOEDPH,PSOA,PSORDT,PSOOK,PSOA,DATA 65 S PSOOK=$$CHKRX(PSORXN,PSOREF) Q:PSOOK'=1 "^^" 66 I 'PSOREF D GETS^DIQ(52,PSORXN,"20;23;31","I","DATA") 67 E D GETS^DIQ(52.1,PSOREF_","_PSORXN,"4;8;17","I","DATA") 68 I PSOREF=0 D 69 . S PSORPH=+$G(DATA(52,PSORXN_",",23,"I")) S:PSORPH=0 PSORPH="" 70 . S DIV=+$G(DATA(52,PSORXN_",",20,"I")) 71 . S PSORDT=+$G(DATA(52,PSORXN_",",31,"I")) 72 I PSOREF>0 D 73 . S PSORPH=+$G(DATA(52.1,PSOREF_","_PSORXN_",",4,"I")) S:PSORPH=0 PSORPH="" 74 . S DIV=+$G(DATA(52.1,PSOREF_","_PSORXN_",",8,"I")) 75 . S PSORDT=+$G(DATA(52.1,PSOREF_","_PSORXN_",",17,"I")) 76 Q:PSORDT=0 "^^" 77 ;last activity - get last one with a user 78 I $D(^PSRX(PSORXN,"A",0)) S PSOA=$P(^PSRX(PSORXN,"A",0),"^",3) D 79 . F II=PSOA:-1:1 S PSOEDPH=$$GET1^DIQ(52.3,II_","_PSORXN_",",".03","I") Q:PSOEDPH'="" 80 ;get IB Service Section (requested by Ed Z. on 6/29/05) 81 S IBSS=$P($G(^PS(59,DIV,"IB")),"^") 82 S:'$G(PSOEDPH) PSOEDPH=PSORPH 83 S PSORPH=$G(PSORPH)_"^"_$G(PSOEDPH)_"^"_$G(IBSS) 84 Q PSORPH 85 ; 86 CHKRX(PSORX,PSOF) ;validates Rx & fill. 0=not valid, 1=valid, 2=refill not valid 87 Q:PSORX=""!(PSOF="") 0 88 Q:'$D(^PSRX(PSORX)) 0 89 Q:PSOF>0&('$D(^PSRX(PSORX,1,PSOF))) 2 90 Q 1 91 ; 92 MCDIV(RX,FILL) ;Get MC DIVISION from the Rx/Fill 93 N DIV,INST 94 ; outpatient division 95 I 'FILL S DIV=$$GET1^DIQ(52,RX,20,"I") 96 E S DIV=$$GET1^DIQ(52.1,FILL_","_RX,8,"I") 97 Q:'DIV "" 98 ; related institution 99 S INST=$$GET1^DIQ(59,DIV,100,"I") Q:'INST "" 100 S DIV=$O(^DG(40.8,"AD",INST,0)) ; pointer to medical center division 101 Q DIV 102 ; 103 CLOK ; 104 N I S I=0 F S I=$O(^PS(59,I)) Q:'I!(CL>0) D 105 . 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")),"^") 106 Q 107 ;
Note:
See TracChangeset
for help on using the changeset viewer.
