| 1 | PSOHLNE3 ;BIR/LE - Process Edit Information from CPRS ;02/27/04
|
|---|
| 2 | ;;7.0;OUTPATIENT PHARMACY;**143,239,201**;DEC 1997
|
|---|
| 3 | ;External reference to ^OR(100 private DBIA 2219
|
|---|
| 4 | ;External reference VADPT supported by DBIA 10061
|
|---|
| 5 | ;
|
|---|
| 6 | ;This API is used to update the prescription file when ICD-9 diagnosis and SC/EI's are updated as a result of an e-sig in CPRS.
|
|---|
| 7 | ;
|
|---|
| 8 | EN(DFN,ORITEM,ORIEN,ORDX,ORSCEI) ;ENTRY POINT
|
|---|
| 9 | ; Used to import edit information from CPRS
|
|---|
| 10 | ;Where Input:
|
|---|
| 11 | ;DFN = Patient IEN
|
|---|
| 12 | ;ORITEM = Package reference number from file 100
|
|---|
| 13 | ;ORIEN = ien from file 100
|
|---|
| 14 | ;ORDX(1)= (pointer to file 80) up to 8 accepted and first is primary ICD
|
|---|
| 15 | ;ORDX(2)= (pointer to file 80)
|
|---|
| 16 | ;ORSCEI= seven pieces - where 1=yes, 0=no, null or ? =not asked
|
|---|
| 17 | ; ORSCEI=AO^IR^SC^EC^MST^HNC^CV
|
|---|
| 18 | N %,DX,DX2,DX3,RXN,PSOSCP,PSOX,ORDPROV,PSOSCP2,DA,RET,PSOANSQ,PSORX,PTSTATUS,ARRAY,PSOOI,ORITEM2,ORID,OICHK,PSORENW
|
|---|
| 19 | N PSODCPY,PSONEW,PSOOIBQ,PSOFLD,PSODCZ,PSOSTAZ,PREA,PSOPIBQ,PSOIBQC,PSOSCA,PSOPICD,PSODGUP,PSOOICD,PSOPFS,TYPE,PSONW,PSOOLD,PSODA
|
|---|
| 20 | N PSODD,PSOSI,X,PSOSITE,PSOBILL,PSOCPAY,PSOCICD
|
|---|
| 21 | S:'$D(ORIEN) ORIEN="" S:'$D(ORSCEI) ORSCEI="" S:'$D(ORITEM) ORITEM=""
|
|---|
| 22 | ;
|
|---|
| 23 | ;validate prescription IEN with DFN, ord item, and placer#
|
|---|
| 24 | S RET=1,PSODCZ=",12,14,15,"
|
|---|
| 25 | S RXN=ORITEM I '$D(^PSRX(RXN)) S RET="0^1" Q RET ;invalid RX ien
|
|---|
| 26 | I $D(^PSRX(RXN,"STA")) S PSOSTAZ=^PSRX(RXN,"STA")
|
|---|
| 27 | ; get prescription file patient ien, drug, and placer order #
|
|---|
| 28 | D GETS^DIQ(52,RXN_",","2;6;39.3","I","ARRAY")
|
|---|
| 29 | I '$D(ARRAY(52,RXN_",",2,"I")) S RET="0^3" Q RET ;quit if you don't have a patient ien
|
|---|
| 30 | I ARRAY(52,RXN_",",2,"I")'=DFN S RET="0^3" Q RET ;quit if patient dfn is different
|
|---|
| 31 | I '$D(ARRAY(52,RXN_",",39.3,"I")) S ARRAY(52,RXN_",",39.3,"I")="" ;if don't have it; treat is as null
|
|---|
| 32 | I ARRAY(52,RXN_",",39.3,"I")'="" I ARRAY(52,RXN_",",39.3,"I")'=ORIEN S RET="0^5" Q RET ;placer # is different
|
|---|
| 33 | I ARRAY(52,RXN_",",39.3,"I")="" S OICHK=0 D CHKOI I OICHK S RET="0^4" Q RET ;quit if placer # is null and orderable item is different or null.
|
|---|
| 34 | ;end of validation process
|
|---|
| 35 | ;
|
|---|
| 36 | S PSODD=$$GET1^DIQ(52,RXN_",",6,"I") S:($P($G(^PSDRUG(PSODD,0)),"^",3)["S")!($P($G(^(0)),"^",3)["I") PSOSI=1
|
|---|
| 37 | S PSOPIBQ=$G(^PSRX(RXN,"IBQ")),PSOPICD=$P($G(^PSRX(RXN,"ICD",1,0)),"^",2,7)
|
|---|
| 38 | S PSOX("IRXN")=RXN,PSORENW("IRXN")=RXN
|
|---|
| 39 | S (PSONEW("PATIENT STATUS"),PTSTATUS)=$$GET1^DIQ(52,RXN_",","3","I")
|
|---|
| 40 | I '$D(PTSTATUS) S (PSONEW("PATIENT STATUS"),PTSTATUS)=""
|
|---|
| 41 | ;if patient status is null, treat same as PSONEW2, PSORN52, PSONEWG, AND PSONEWF. If piece 7 of ^PS(53 doesn't equal 1, it's not exempt from copay.
|
|---|
| 42 | I ORSCEI["?" S ORSCEI=$TR(ORSCEI,"?","")
|
|---|
| 43 | D SCP^PSORN52D
|
|---|
| 44 | S PSOANSQ(PSOX("IRXN"),"VEH")=$P(ORSCEI,U,1)
|
|---|
| 45 | S PSOANSQ(PSOX("IRXN"),"RAD")=$P(ORSCEI,U,2)
|
|---|
| 46 | I PSOSCP<50&($P($G(^PS(53,+$G(PTSTATUS),0)),"^",7)'=1) S PSOANSQ(PSOX("IRXN"),"SC")=$P(ORSCEI,U,3),PSOANSQ("SC")=$P(ORSCEI,U,3)
|
|---|
| 47 | I PSOSCP>49!($P($G(^PS(53,+$G(PTSTATUS),0)),"^",7)=1) S PSOANSQ(PSOX("IRXN"),"SC>50")=$P(ORSCEI,U,3),PSOANSQ("SC>50")=$P(ORSCEI,U,3)
|
|---|
| 48 | I PSOSCP=""&('$D(PSOANSQ("SC")))&($D(^PSRX(RXN,"ICD",1))) S PSOANSQ("SC")=$P(^PSRX(RXN,"ICD",1,0),"^",4),PSOANSQ(PSOX("IRXN"),"SC")=PSOANSQ("SC") ;for SC with no percentage defined/ legacy
|
|---|
| 49 | S PSOANSQ(PSOX("IRXN"),"PGW")=$P(ORSCEI,U,4)
|
|---|
| 50 | S PSOANSQ(PSOX("IRXN"),"MST")=$P(ORSCEI,U,5)
|
|---|
| 51 | S PSOANSQ(PSOX("IRXN"),"HNC")=$P(ORSCEI,U,6)
|
|---|
| 52 | S PSOANSQ(PSOX("IRXN"),"CV")=$P(ORSCEI,U,7)
|
|---|
| 53 | ;
|
|---|
| 54 | S DX="",DX2=0 F S DX=$O(ORDX(DX)) Q:DX="" S DX2=DX2+1,PSORX("ICD",DX2)=ORDX(DX) ;Multi signed Rx's come in consecutively and the diagnosis subscript doesn't start with 1 for each Rx
|
|---|
| 55 | S PSOSCP2=1 ;used in PSORN52D
|
|---|
| 56 | ;
|
|---|
| 57 | ICD2 ;Check to see if SC/EI changed during CPRS sign order
|
|---|
| 58 | D GETS^DIQ(52,PSOX("IRXN")_",","52311*","I","PSOOICD")
|
|---|
| 59 | S PSODCPY=0,PSOFLD=""
|
|---|
| 60 | F TYPE="VEH","RAD","SC>50","PGW","MST","HNC","CV" Q:PSODCPY F PSOFLD=1:1:7 D Q:PSODCPY
|
|---|
| 61 | . I TYPE="VEH"&(PSOFLD=1) D CHOC
|
|---|
| 62 | . I TYPE="RAD"&(PSOFLD=2) D CHOC
|
|---|
| 63 | . I TYPE="SC>50"&(PSOFLD=3)&($D(PSOANSQ(PSOX("IRXN"),TYPE))) D CHOC
|
|---|
| 64 | . I TYPE="PGW"&(PSOFLD=4) D CHOC
|
|---|
| 65 | . I TYPE="MST"&(PSOFLD=5) D CHOC
|
|---|
| 66 | . I TYPE="HNC"&(PSOFLD=6) D CHOC
|
|---|
| 67 | . I TYPE="CV"&(PSOFLD=7) D CHOC
|
|---|
| 68 | I $D(PSOANSQ("SC")) S PSOFLD=3 S:PSOANSQ("SC")'=PSOOICD(52.052311,1_","_PSOX("IRXN")_",",PSOFLD,"I") PSODCPY=1,PSOFLD=""
|
|---|
| 69 | ; IF NO SC/EI DIFFERENCES, CHECK FOR ICD CHANGES. If there were SC/EI difference, don't need to check ICD because they are sent anyway when copay update is done.
|
|---|
| 70 | I '$G(PSODCPY) D
|
|---|
| 71 | .I '$D(PSORX("ICD"))&($G(PSOOICD(52.052311,1_","_RXN_",",.01,"I"))) S PSODGUP=1 Q ;if no ICD's passed and ICD's defined in 52, CPRS overrides OP
|
|---|
| 72 | .S (DX3,DX2,DX)="" F S DX=$O(PSOOICD(52.052311,DX)) Q:DX="" S DX2=+DX ;get last entry for file 52
|
|---|
| 73 | .S DX="" F S DX=$O(PSORX("ICD",DX)) Q:DX="" S DX3=DX D ;get last entry for new ICD's from CPRS
|
|---|
| 74 | .. I $G(PSOOICD(52.052311,DX_","_PSOX("IRXN")_",",.01,"I"))'=PSORX("ICD",DX) S PSODGUP=1 ;if ICD'S changed or more new ICD's than old ones.
|
|---|
| 75 | .I DX2>DX3 S PSODGUP=1 ;if more old ICD's than new ones
|
|---|
| 76 | Q:'$G(PSODCPY)&('$G(PSODGUP)) 1
|
|---|
| 77 | D FILE2^PSORN52D ;file SC/EI/ICD'S into Rx file
|
|---|
| 78 | ;S PSOCIDC=$P($G(^PSRX(RXN,"ICD",1,0)),"^",2,7)
|
|---|
| 79 | ;only do copay if SC/EI changed and SC is less than 50%.
|
|---|
| 80 | I PSODCZ[(","_$G(PSOSTAZ)_",") S RET="0^6" Q RET ;discontinue's no copay changes allowed.
|
|---|
| 81 | ;
|
|---|
| 82 | ;Get last fill number
|
|---|
| 83 | N PSOLFIL S PSOLFIL=$$LF^PSOPFSU1(RXN)
|
|---|
| 84 | S PSOPFS=$P($S('PSOLFIL:$G(^PSRX(RXN,"PFS")),1:$G(^PSRX(RXN,1,PSOLFIL,"PFS"))),"^",1,2)
|
|---|
| 85 | ; No-copay to copay updates
|
|---|
| 86 | S PSOIBQC=$G(^PSRX(RXN,"IBQ")),PSOCICD=$P($G(^PSRX(RXN,"ICD",1,0)),"^",2,7)
|
|---|
| 87 | D CPAY
|
|---|
| 88 | ; must check IBQ node in case it's a pre-CIDC rx/copay, ICD node for exempt/supply items, and for diagnosis updates for NSC Rx's
|
|---|
| 89 | I (PSOPIBQ[1&(PSOIBQC'[1))!(PSOIBQC=""&(PSOPICD[1&(PSOCICD'[1)))!($G(PSODGUP)) D Q RET ;don't do no copay to copay bills, but update status
|
|---|
| 90 | . D ALOG
|
|---|
| 91 | . I (PSOSCP<50)&($G(PSODCPY)) D
|
|---|
| 92 | .. I $P($G(^PS(53,+$G(PTSTATUS),0)),"^",7)'=1&('$G(PSOSI)) D
|
|---|
| 93 | ... S:+$G(PSOCPAY)<1&($D(^PSRX(RXN,"IB"))) $P(^PSRX(RXN,"IB"),"^",1)=""
|
|---|
| 94 | ... I +$G(PSOCPAY)>0 S $P(^PSRX(RXN,"IB"),"^",1)=+$G(PSOCPAY),PSOOLD="No Copay",PSONW="Copay",PREA="R",PSODA=RXN D:'$G(PSOSI) ACTLOG^PSOCPA
|
|---|
| 95 | . I +$G(PSOPFS)>0&('$P($G(PSOPFS),"^",2)) K PSOPFS Q ;don't send unreleased charge msg
|
|---|
| 96 | . I +$G(PSOPFS)<1 K PSOPFS ;invalid PFSS ACCT REF/ SEND TO IB
|
|---|
| 97 | . I +$G(PSOPFS)>0 S PSOPFS="1^"_PSOPFS
|
|---|
| 98 | . ;
|
|---|
| 99 | . I +$G(PSOPFS) D CHRG^PSOPFSU1(RXN,PSOLFIL,"CG",PSOPFS) ;always send to external bill sys
|
|---|
| 100 | ;
|
|---|
| 101 | ; Copay to no-copay updates
|
|---|
| 102 | I $G(PSODCPY) D COPAY^PSOHLNE4
|
|---|
| 103 | ;ICD UPDATE ONLY FOR COPAYS
|
|---|
| 104 | I ('$G(PSODCPY)&($G(PSODGUP)))&($P($G(PSOPFS),"^",2)) D CHRG^PSOPFSU1(RXN,PSOLFIL,"CG",PSOPFS) ;DIAGNOSIS UPDATE ONLY
|
|---|
| 105 | I ($G(PSODCPY)!($G(PSODGUP))) D ALOG
|
|---|
| 106 | Q RET
|
|---|
| 107 | ;
|
|---|
| 108 | CPAY ;
|
|---|
| 109 | N X,Y,III,ACTYP,BL
|
|---|
| 110 | S PSOSITE=$P(^PSRX(RXN,2),"^",9)
|
|---|
| 111 | S X=$P($G(^PS(59,+PSOSITE,"IB")),"^")_"^"_DFN D XTYPE^IBARX
|
|---|
| 112 | S (ACTYP,BL)="",(PSOBILL,PSOCPAY)=0
|
|---|
| 113 | CPAY1 ;
|
|---|
| 114 | S ACTYP=$O(Y(ACTYP)) G:'ACTYP CSKP F III=0:0 S BL=$O(Y(ACTYP,BL)) Q:BL="" I BL>0 S PSOBILL=BL,PSOCPAY=BL_"^"_Y(ACTYP,BL)
|
|---|
| 115 | G CPAY1
|
|---|
| 116 | CSKP ;
|
|---|
| 117 | S:$G(PSOSI) PSOCPAY=0 ;Supply item/investigational drug
|
|---|
| 118 | S:$P($G(^PS(53,+$G(PTSTATUS),0)),"^",7)=1 PSOCPAY=0 ;Rx Patient Status exempt
|
|---|
| 119 | I PSOIBQC'="" S:PSOIBQC'[1 PSOCPAY=1 ;Yes SC/EI from CPRS
|
|---|
| 120 | I (PSOBILL'>0)!(PSOCPAY=0) S PSOCPAY=0 ;INELIGIBLE
|
|---|
| 121 | Q
|
|---|
| 122 | ;
|
|---|
| 123 | CHOC ;check outpatient classifications
|
|---|
| 124 | S:PSOANSQ(PSOX("IRXN"),TYPE)'=PSOOICD(52.052311,1_","_PSOX("IRXN")_",",PSOFLD,"I") PSODCPY=1
|
|---|
| 125 | Q
|
|---|
| 126 | ;
|
|---|
| 127 | ALOG ;set activity log with edit info from cprs
|
|---|
| 128 | N ACNT,SUB,RF,RFCNT
|
|---|
| 129 | S ACNT=0 F SUB=0:0 S SUB=$O(^PSRX(RXN,"A",SUB)) Q:'SUB S ACNT=SUB
|
|---|
| 130 | S RFCNT=0 F RF=0:0 S RF=$O(^PSRX(RXN,1,RF)) Q:'RF S RFCNT=RF S:RF>5 RFCNT=RF+1
|
|---|
| 131 | D NOW^%DTC S ACNT=ACNT+1
|
|---|
| 132 | S ^PSRX(RXN,"A",0)="^52.3DA^"_ACNT_"^"_ACNT S ^PSRX(RXN,"A",ACNT,0)=%_"^"_"E"_"^^"_RFCNT_"^Clinical Indicators and SC/EI's were updated from a CPRS e-sig edit at "_$E($P(%,".",2),1,2)_":"_$E($P(%,".",2),3,4)_"."
|
|---|
| 133 | Q
|
|---|
| 134 | ;
|
|---|
| 135 | CHKOI ;get and compare orderable items in file #100 and #52; don't process
|
|---|
| 136 | ; if it's different and the placer # is null.
|
|---|
| 137 | I '$D(ARRAY(52,RXN_",",6,"I")) S OICHK=1 Q
|
|---|
| 138 | D GETS^DIQ(50,ARRAY(52,RXN_",",6,"I")_",","2.1","I","PSOOI")
|
|---|
| 139 | S ORITEM2=$$GET1^DIQ(100.001,"1,"_ORIEN_",",".01","I")
|
|---|
| 140 | S ORID=$$GET1^DIQ(101.43,ORITEM2_",","2","I") S ORID=$P(ORID,";",1)
|
|---|
| 141 | I PSOOI(50,ARRAY(52,RXN_",",6,"I")_",",2.1,"I")'="" I PSOOI(50,ARRAY(52,RXN_",",6,"I")_",",2.1,"I")'=ORID S OICHK=1
|
|---|
| 142 | Q
|
|---|
| 143 | TEST(ORIEN) ;manually test an individual order record
|
|---|
| 144 | N I,X,ORSCEIS,ORSCEI,ORDX,EDFLG,ORITEM,DFN,JJ
|
|---|
| 145 | S (JJ,I)=0 F S I=$O(^OR(100,ORIEN,5.1,I)) Q:I=""!(I'?1N.NN) S JJ=JJ+1,ORDX(JJ)=$G(^OR(100,ORIEN,5.1,I,0))
|
|---|
| 146 | S ORSCEIS=^OR(100,ORIEN,5.2),ORITEM=$P($G(^OR(100,ORIEN,4)),"^",1)
|
|---|
| 147 | S ORSCEI="" F I=3,4,1,5,2,6,7 S ORSCEI=ORSCEI_"^"_$P(ORSCEIS,"^",I)
|
|---|
| 148 | S ORSCEI=$E(ORSCEI,2,99)
|
|---|
| 149 | S RXN=ORITEM,DFN=$P($P(^OR(100,ORIEN,0),"^",2),";",1)
|
|---|
| 150 | D EN^PSOHLNE3(DFN,ORITEM,ORIEN,.ORDX,ORSCEI)
|
|---|
| 151 | Q
|
|---|
