| [613] | 1 | PSOBPSU2 ;BIRM/MFR - BPS (ECME) Utilities 2 ;10/15/04
|
|---|
| 2 | ;;7.0;OUTPATIENT PHARMACY;**260**;DEC 1997;Build 84
|
|---|
| 3 | ;Reference to File 200 - NEW PERSON supported by IA 10060
|
|---|
| 4 | ;
|
|---|
| 5 | MWC(RX,RFL) ; Returns wheter a prescription is (M)ail, (W)indow or (C)MOP
|
|---|
| 6 | ;Input: (r) RX - Rx IEN (#52)
|
|---|
| 7 | ; (o) RFL - Refill # (Default: most recent)
|
|---|
| 8 | ;Output: "M": MAIL / "W": WINDOW / "C": CMOP
|
|---|
| 9 | ;
|
|---|
| 10 | N MWC
|
|---|
| 11 | ;
|
|---|
| 12 | I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
|
|---|
| 13 | ;
|
|---|
| 14 | ; - MAIL/WINDOW fields (Original and Refill)
|
|---|
| 15 | I RFL S MWC=$$GET1^DIQ(52.1,RFL_","_RX,2,"I")
|
|---|
| 16 | E S MWC=$$GET1^DIQ(52,RX,11,"I")
|
|---|
| 17 | S:MWC="" MWC="W"
|
|---|
| 18 | ;
|
|---|
| 19 | ; - Checking the RX SUSPENSE file (#52.5)
|
|---|
| 20 | I $$GET1^DIQ(52,RX,100,"I")=5 D
|
|---|
| 21 | . N RXS S RXS=+$O(^PS(52.5,"B",RX,0)) Q:'RXS
|
|---|
| 22 | . I $$GET1^DIQ(52.5,RXS,3,"I")'="" S MWC="C" Q
|
|---|
| 23 | . S MWC="M"
|
|---|
| 24 | ;
|
|---|
| 25 | ; - Checking the CMOP EVENT sub-file (#52.01)
|
|---|
| 26 | I MWC'="C" D
|
|---|
| 27 | . N CMP S CMP=0
|
|---|
| 28 | . F S CMP=$O(^PSRX(RX,4,CMP)) Q:'CMP D I MWC="C" Q
|
|---|
| 29 | . . I $$GET1^DIQ(52.01,CMP_","_RX,2,"I")=RFL S MWC="C"
|
|---|
| 30 | ;
|
|---|
| 31 | Q MWC
|
|---|
| 32 | ;
|
|---|
| 33 | RXACT(RX,RFL,COMM,TYPE,USR) ; - Add an Activity to the ECME Activity Log (PRESCRIPTION file)
|
|---|
| 34 | ;Input: (r) RX - Rx IEN (#52)
|
|---|
| 35 | ; (o) RFL - Refill # (Default: most recent)
|
|---|
| 36 | ; (r) COMM - Comments (up to 75 characters)
|
|---|
| 37 | ; (r) TYPE - Comments type: (M-ECME,E-Edit, etc...) See file #52 DD for all values
|
|---|
| 38 | ; (o) USR - User logging the comments (Default: DUZ)
|
|---|
| 39 | ;
|
|---|
| 40 | S:'$D(RFL) RFL=$$LSTRFL^PSOBPSU1(RX) S:'$D(USR) USR=DUZ
|
|---|
| 41 | S:'$D(^VA(200,+USR,0)) USR=DUZ S COMM=$E($G(COMM),1,75)
|
|---|
| 42 | ;
|
|---|
| 43 | I COMM="" Q
|
|---|
| 44 | I '$D(^PSRX(RX)) Q
|
|---|
| 45 | ;
|
|---|
| 46 | N X,DIC,DA,DD,DO,DR,DINUM,Y,DLAYGO
|
|---|
| 47 | S DA(1)=RX,DIC="^PSRX("_RX_",""A"",",DLAYGO=52.3,DIC(0)="L"
|
|---|
| 48 | S DIC("DR")=".02///"_TYPE_";.03////"_USR_";.04///"_$S(TYPE'="M"&(RFL>5):RFL+1,1:RFL)_";.05///"_COMM
|
|---|
| 49 | S X=$$NOW^XLFDT() D FILE^DICN
|
|---|
| 50 | Q
|
|---|
| 51 | ;
|
|---|
| 52 | ECMENUM(RX) ; Returns the ECME number for a specific prescription
|
|---|
| 53 | N ECMENUM,STS,RF
|
|---|
| 54 | S ECMENUM=$E(10000000+RX,2,8)
|
|---|
| 55 | S STS=$$STATUS^PSOBPSUT(RX,0)
|
|---|
| 56 | I STS="" D
|
|---|
| 57 | . S RF=0 F S RF=$O(^PSRX(RX,RF)) Q:'RF D I STS'="" Q
|
|---|
| 58 | . . S STS=$$STATUS^PSOBPSUT(RX,RF)
|
|---|
| 59 | I STS="" Q ""
|
|---|
| 60 | Q ECMENUM
|
|---|
| 61 | ;
|
|---|
| 62 | RXNUM(ECME) ; Returns the Rx number for a specific ECME number
|
|---|
| 63 | ;
|
|---|
| 64 | N RXNUM,FOUND,MAX,LFT,RAD,I,DIR,RX
|
|---|
| 65 | S MAX=$O(^PSRX(999999999999),-1),LFT=0 I $L(MAX)>7 S LFT=$E(MAX,1,$L(MAX)-7)
|
|---|
| 66 | S FOUND=0
|
|---|
| 67 | F RAD=LFT:-1:0 D
|
|---|
| 68 | . S RX=RAD*10000000+ECME I $D(^PSRX(RX,0)),$$ECMENUM(RX)=ECME S FOUND=FOUND+1,FOUND(FOUND)=RX
|
|---|
| 69 | ;
|
|---|
| 70 | I FOUND<2 D
|
|---|
| 71 | . I FOUND=0 S FOUND=-1 Q
|
|---|
| 72 | . S FOUND=FOUND(1)
|
|---|
| 73 | E D
|
|---|
| 74 | . W ! F I=1:1:FOUND W !?5,I,". ",$$GET1^DIQ(52,FOUND(I),.01),?25,$$GET1^DIQ(52,FOUND(I),6)
|
|---|
| 75 | . W ! S DIR(0)="NA^1:"_FOUND,DIR("A")="Select one: ",DIR("B")=1
|
|---|
| 76 | . D ^DIR I $D(DIRUT) S FOUND=-1 Q
|
|---|
| 77 | . S FOUND=FOUND(Y)
|
|---|
| 78 | ;
|
|---|
| 79 | Q FOUND
|
|---|
