- 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/PSOPFSU1.m
r613 r623 1 PSOPFSU1 2 ;;7.0;OUTPATIENT PHARMACY;**201,225**;DEC 1997;Build 29 3 4 5 6 CHRG(PSORXN,PSOREF,PSOCHTYP,PSOPFS) 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 CHRGOF 55 56 57 58 59 60 61 62 63 CHRGRF 64 65 66 67 68 69 70 71 72 GOC 73 74 75 76 . I I=1 F J=1:1:8Q:'$D(PSORX(52.052311,I_","_PSORXN_",",J,"I")) D77 78 79 80 81 CG 82 83 84 85 86 87 88 89 LF(PSODA) 90 91 92 93 94 PFSI(PSODA,PSOREF) 95 96 97 98 99 PFSA(PSODA,PSOREF,WR) 100 101 102 103 104 105 106 107 108 109 PFS 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 1 PSOPFSU1 ;BIR/LE,AM - PFSS Charge Message & Utilities ;08/09/93 2 ;;7.0;OUTPATIENT PHARMACY;**201**;DEC 1997 3 ;External reference CHARGE^IBBAPI and GETCHGID^IBBAPI supported by DBIA 4665 4 Q 5 ; 6 CHRG(PSORXN,PSOREF,PSOCHTYP,PSOPFS) ;ENTRY POINT: 7 ;Used to pass charge msg info to an external billing system via IBB API's 8 ; Inputs: PSORXN = RX IEN, PSOREF = fill number, PSOCHTYP = "CG" for Charge or "CD" for Credit transaction, 9 ; PSOPFS = switch status (0 or 1) ^ PFSS Account Reference for the fill ^ PFSS Charge ID for the fill 10 ; Outputs: none 11 ; 12 N I,CLDIV,IFN,J,PSODG,PSOZCL,PSOCHID,PSOPFSA,PSODFN,PSORX,PSOFT1,PSODRG,PSODRUG,PSORXE,PSOCHG,PSOFD,PSOFT,PSOFLD 13 ; quit if PFSS switch is off or not defined 14 Q:'+$G(PSOPFS) 15 ; 16 ; check for CHARGE LOCATION before processing charge message. 17 S CLDIV=$$CHLOC^PSOPFSU0() 18 Q:CLDIV<1 ;if no CHARGE LOCATION, don't send charge message to either IB or external billing system. 19 ; 20 ; check for PFSS Acct Reference; if not one define, request one 21 S PSOPFSA=$P(PSOPFS,"^",2) 22 I PSOPFSA<1 D PFSI(PSORXN,PSOREF) S PSOPFSA=$P(PSOPFS,"^",2) I PSOPFSA<1 D ;because PSOCP is too large, need to check for/get them here 23 .S PSOPFSA=$$GACT^PSOPFSU0(PSORXN,PSOREF) 24 Q:PSOPFSA<1 ;Normally IB returns an acct ref or zero for unsuccessful if a problem is encountered. 25 ; If IBB didn't return a value, don't send charge message because IBB will produce a hard error. Subsequent phase of PFSS will provide further error handling. 26 ; 27 ; check for PFSS Charge ID. If no charge ID, means Rx never sent to external bill sys or there was a problem retrieve one. 28 S PSOCHID=$P(PSOPFS,"^",3) 29 ;If no Charge ID is defined, request a Unique Charge ID and store it in file 52 30 I PSOCHID<1 S PSOCHID=$$GETCHGID^IBBAPI() I PSOCHID>0 D 31 . I PSOREF=0 S $P(^PSRX(PSORXN,"PFS"),"^",2)=PSOCHID ;set directly for speed (CMOPs, etc.) 32 . I PSOREF>0 S $P(^PSRX(PSORXN,1,PSOREF,"PFS"),"^",2)=PSOCHID 33 Q:PSOCHID<1 ;no charge message will be sent if can't get a PFSS CHARGE ID from IB. Subsequent phase of PFSS will provide error handling for this type problem. 34 ;Retrieve all fields to pass for the charge message 35 S PSOFT="4,10,21" I PSOREF=0 D CHRGOF 36 I PSOREF>0 D CHRGRF 37 ;Get general Rx data fields 38 D GETS^DIQ(52,PSORXN,"2;3;6;105","I","PSORX") 39 S PSOFT1(29)=$$NDC^PSOHDR(PSORXN,PSOREF,$S(PSOREF>0:"R",1:"")) 40 S PSODFN=$G(PSORX(52,PSORXN_",",2,"I")),PSODRG=$G(PSORX(52,PSORXN_",",6,"I")),PSOFT1(31)=$G(PSORX(52,PSORXN_",",105,"I")) 41 D DATA^PSS50(PSODRG,,,,,"PSOSC") 42 ;S PSOFT1(2)="PSO"_PSORXN_"F"_PSOREF ;12/6/05; DECISION MADE TO NOT SEND clinicial event indicator FOR OP 43 S PSOFT1(7)=$G(^TMP($J,"PSOSC",PSODRG,400)),PSOFT1(6)=PSOCHTYP,PSOFT1(13)=160 44 S PSOFT1(18)=$G(PSORX(52,PSORXN_",",3,"I")),PSOFT1(18)=$$GET1^DIQ(53,PSOFT1(18)_",",15,"I") 45 S PSOFT1(22)=$FN($G(^TMP($J,"PSOSC",PSODRG,16)),"",2),PSOFT1(29)=PSOFT1(29)_";"_$G(^TMP($J,"PSOSC",PSODRG,.01)) 46 S PSORXE(31)=$G(^TMP($J,"PSOSC",PSODRG,3)),PSORXE(17)=PSOREF 47 S:(PSORXE(18)="") PSORXE(18)=$G(RELDT) ;CMOP 48 S PSORXE(15)=PSORXN 49 S PSOCHG=$$CHARGE^IBBAPI(PSODFN,PSOPFSA,PSOCHTYP,PSOCHID,.PSOFT1,"",.PSODG,.PSOZCL,.PSORXE,"","") 50 ;errors to be handled in subsequent phase 51 K ^TMP($J,"PSOSC") 52 Q 53 ; 54 CHRGOF ;Retrieve charge fields for orig fills 55 D GETS^DIQ(52,PSORXN,"4;7;8;22;31;125","I","PSORX") 56 S PSOFD="22,7,4" 57 F I=1:1 S PSOFLD=$P(PSOFD,",",I) Q:PSOFLD="" S PSOFT1($P(PSOFT,",",I))=$G(PSORX(52,PSORXN_",",$P(PSOFD,",",I),"I")) 58 S PSOPFSA=$G(PSORX(52,PSORXN_",",125,"I")),PSORXE(18)=$G(PSORX(52,PSORXN_",",31,"I")) 59 S PSORXE(1)=PSOFT1(10)_";;"_$G(PSORX(52,PSORXN_",",8,"I")) 60 D GOC 61 Q 62 ; 63 CHRGRF ;Retrieve charge fields for refills 64 D GETS^DIQ(52.1,PSOREF_","_PSORXN,".01;1;1.1;15;17;21","I","PSORX") 65 S PSOFD=".01,1,15" 66 F I=1:1 S PSOFLD=$P(PSOFD,",",I) Q:PSOFLD="" S PSOFT1($P(PSOFT,",",I))=$G(PSORX(52.1,PSOREF_","_PSORXN_",",$P(PSOFD,",",I),"I")) 67 S PSOPFSA=$G(PSORX(52.1,PSOREF_","_PSORXN_",",21,"I")),PSORXE(18)=$G(PSORX(52.1,PSOREF_","_PSORXN_",",17,"I")) 68 S PSORXE(1)=PSOFT1(10)_";;"_$G(PSORX(52.1,PSOREF_","_PSORXN_",",1.1,"I")) 69 D GOC 70 Q 71 ; 72 GOC ;Called from CHRGOF, CHRGRF. Parse OP classifications and ICD's. Don't send null values. 73 D GETS^DIQ(52,PSORXN,"52311*","I","PSORX") 74 F I=1:1 Q:'$D(PSORX(52.052311,I_","_PSORXN_",")) D 75 . S:PSORX(52.052311,I_","_PSORXN_",",".01","I")'="" PSODG(I,3)=PSORX(52.052311,I_","_PSORXN_",",".01","I"),PSODG(I,6)="F" 76 . I I=1 F J=1:1:7 Q:'$D(PSORX(52.052311,I_","_PSORXN_",",J,"I")) D 77 . . S:PSORX(52.052311,I_","_PSORXN_",",J,"I")'="" PSOZCL(J,2)=J,PSOZCL(J,3)=PSORX(52.052311,I_","_PSORXN_",",J,"I") 78 S:'$D(PSOZCL) PSOZCL="" S:'$D(PSODG) PSODG="" 79 Q 80 ; 81 CG ;Called from PSOCPB; for the last fill, send chrg message if released; PSOCPB too large for more code. 82 ; this is used for SC/EI changes when no charges are cancelled. Expects to have PSODA = RXIEN and PSOLFIL= fill# 83 ;N REL,PFS 84 ;I 'PSOLFIL S REL=$$GET1^DIQ(52,PSODA_",","31","I") 85 ;I PSOLFIL>0 S REL=$$GET1^DIQ(52.1,PSOLFIL_","_PSODA_",","17","I") ;REFILL 86 ;I REL'=""&(PSOPFS)&(+$G(PSOPFSA)) D CHRG(PSODA,PSOLFIL,"CG",PSOPFS) 87 Q 88 ; 89 LF(PSODA) ;return last fill number;CALLED from PSOCPB 90 N LF 91 I $D(^PSRX(PSODA,1,0)) S LF="A",LF=$O(^PSRX(PSODA,1,LF),-1) Q LF 92 Q 0 ;ORIG FILL 93 ; 94 PFSI(PSODA,PSOREF) ;get PFSS Acct Ref and Charge ID and store in PSOPFS; Called from multiple places in this routine 95 I PSOREF=0&($D(^PSRX(PSODA,"PFS"))) S PSOPFS=PSOPFS_"^"_$P(^PSRX(PSODA,"PFS"),"^",1,2) Q 96 I PSOREF>0&($D(^PSRX(PSODA,1,PSOREF,"PFS"))) S PSOPFS=PSOPFS_"^"_$P(^PSRX(PSODA,1,PSOREF,"PFS"),"^",1,2) 97 Q 98 ; 99 PFSA(PSODA,PSOREF,WR) ;called from PSOCP (WR=2) and PSOCPB (WR=3) 100 ;get switch status, acct ref, and charge ID, then validate switch vs availability of PFSS acct ref 101 Q:'$G(WR) 102 S PSOPFS=+$$SWSTAT^IBBAPI() 103 D PFSI(PSODA,PSOREF) 104 ; if switch is off, but have an PFSS Acct Ref for new orders, send charge to IDX 105 ; if switch is off, but have a Charge ID, send cancel charge to IDX 106 I '+PSOPFS,$P(PSOPFS,"^",WR)>0 S $P(PSOPFS,"^")=1 107 Q 108 ; 109 PFS ;;Called from PSOCPB; PSOCPB is too large to hold more code. Processes copay cancels for PFS only. 110 ;find any fills being cancelled for PFSS, cancel them, and remove them from PSOCAN, then return to PSOCP to process any IB cancels 111 ; 112 N X,I,PSOREF,PSOOLD,PREA,PSONW 113 ;If it's a PFS fill, if released, and not previously cancelled, set the X array, then kill it out of PSOCAN array. 114 ;Killed out of PSOCAN because don't want the IB processing to look at PFSS billed fills. 115 ;Note that in PSOCPD, PFS entries are not stored in PSOCAN array if a charge ID is not defined. So, don't have to check for release date. 116 ;If prev cancelled and PFS, kill it from PSOCAN array 117 S I="" F S I=$O(PSOCAN(I)) Q:I="" S PSOREF=+PSOCAN(I) D 118 . I PSOREF=PSODA&($P(PSOCAN(I),"^",10)="PFS") D Q 119 . . I $P(PSOCAN(I),"^",5)["CANCEL" K PSOCAN(I) Q 120 . . S X(0)=$P(PSOCAN(I),"^",2)_"^"_PSORSN K PSOCAN(I) 121 . I PSOREF'=PSODA&($P(PSOCAN(I),"^",10)="PFS") D 122 . . I $P(PSOCAN(I),"^",5)["CANCEL" K PSOCAN(I) Q 123 . . S X(PSOREF)=$P(PSOCAN(I),"^",2)_"^"_PSORSN K PSOCAN(I) 124 I $G(CANTYPE)&('$D(X)) D MSGNOCAN^PSOCPB Q ;CANTYPE=1 means trying cancelling all fills;can't cancel twice 125 ; 126 ;send charge messages, set activity log, display message 127 S PREA="C",PSOREF="" 128 F S PSOREF=$O(X(PSOREF)) Q:PSOREF="" S PSOPFS=1 D PFSI(PSODA,PSOREF) D CHRG(PSODA,PSOREF,"CD",PSOPFS) D ACTLOG^PSOCPA D:'$G(CANTYPE) MSG^PSOCPB 129 I $G(CANTYPE)&('$D(PSOCAN)) D MSG^PSOCPB ;if cancelling all and no legacy IB bills to cancel, write msg 130 S PSOPFSA=0 ;reset variable so charge isn't sent twice if SC/EI's were also changed. 131 Q 132 ;
Note:
See TracChangeset
for help on using the changeset viewer.
