80 lines
2.6 KiB
Mathematica
80 lines
2.6 KiB
Mathematica
PSOBPSU2 ;BIRM/MFR - BPS (ECME) Utilities 2 ;10/15/04
|
|
;;7.0;OUTPATIENT PHARMACY;**260**;DEC 1997;Build 84
|
|
;Reference to File 200 - NEW PERSON supported by IA 10060
|
|
;
|
|
MWC(RX,RFL) ; Returns wheter a prescription is (M)ail, (W)indow or (C)MOP
|
|
;Input: (r) RX - Rx IEN (#52)
|
|
; (o) RFL - Refill # (Default: most recent)
|
|
;Output: "M": MAIL / "W": WINDOW / "C": CMOP
|
|
;
|
|
N MWC
|
|
;
|
|
I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
|
|
;
|
|
; - MAIL/WINDOW fields (Original and Refill)
|
|
I RFL S MWC=$$GET1^DIQ(52.1,RFL_","_RX,2,"I")
|
|
E S MWC=$$GET1^DIQ(52,RX,11,"I")
|
|
S:MWC="" MWC="W"
|
|
;
|
|
; - Checking the RX SUSPENSE file (#52.5)
|
|
I $$GET1^DIQ(52,RX,100,"I")=5 D
|
|
. N RXS S RXS=+$O(^PS(52.5,"B",RX,0)) Q:'RXS
|
|
. I $$GET1^DIQ(52.5,RXS,3,"I")'="" S MWC="C" Q
|
|
. S MWC="M"
|
|
;
|
|
; - Checking the CMOP EVENT sub-file (#52.01)
|
|
I MWC'="C" D
|
|
. N CMP S CMP=0
|
|
. F S CMP=$O(^PSRX(RX,4,CMP)) Q:'CMP D I MWC="C" Q
|
|
. . I $$GET1^DIQ(52.01,CMP_","_RX,2,"I")=RFL S MWC="C"
|
|
;
|
|
Q MWC
|
|
;
|
|
RXACT(RX,RFL,COMM,TYPE,USR) ; - Add an Activity to the ECME Activity Log (PRESCRIPTION file)
|
|
;Input: (r) RX - Rx IEN (#52)
|
|
; (o) RFL - Refill # (Default: most recent)
|
|
; (r) COMM - Comments (up to 75 characters)
|
|
; (r) TYPE - Comments type: (M-ECME,E-Edit, etc...) See file #52 DD for all values
|
|
; (o) USR - User logging the comments (Default: DUZ)
|
|
;
|
|
S:'$D(RFL) RFL=$$LSTRFL^PSOBPSU1(RX) S:'$D(USR) USR=DUZ
|
|
S:'$D(^VA(200,+USR,0)) USR=DUZ S COMM=$E($G(COMM),1,75)
|
|
;
|
|
I COMM="" Q
|
|
I '$D(^PSRX(RX)) Q
|
|
;
|
|
N X,DIC,DA,DD,DO,DR,DINUM,Y,DLAYGO
|
|
S DA(1)=RX,DIC="^PSRX("_RX_",""A"",",DLAYGO=52.3,DIC(0)="L"
|
|
S DIC("DR")=".02///"_TYPE_";.03////"_USR_";.04///"_$S(TYPE'="M"&(RFL>5):RFL+1,1:RFL)_";.05///"_COMM
|
|
S X=$$NOW^XLFDT() D FILE^DICN
|
|
Q
|
|
;
|
|
ECMENUM(RX) ; Returns the ECME number for a specific prescription
|
|
N ECMENUM,STS,RF
|
|
S ECMENUM=$E(10000000+RX,2,8)
|
|
S STS=$$STATUS^PSOBPSUT(RX,0)
|
|
I STS="" D
|
|
. S RF=0 F S RF=$O(^PSRX(RX,RF)) Q:'RF D I STS'="" Q
|
|
. . S STS=$$STATUS^PSOBPSUT(RX,RF)
|
|
I STS="" Q ""
|
|
Q ECMENUM
|
|
;
|
|
RXNUM(ECME) ; Returns the Rx number for a specific ECME number
|
|
;
|
|
N RXNUM,FOUND,MAX,LFT,RAD,I,DIR,RX
|
|
S MAX=$O(^PSRX(999999999999),-1),LFT=0 I $L(MAX)>7 S LFT=$E(MAX,1,$L(MAX)-7)
|
|
S FOUND=0
|
|
F RAD=LFT:-1:0 D
|
|
. S RX=RAD*10000000+ECME I $D(^PSRX(RX,0)),$$ECMENUM(RX)=ECME S FOUND=FOUND+1,FOUND(FOUND)=RX
|
|
;
|
|
I FOUND<2 D
|
|
. I FOUND=0 S FOUND=-1 Q
|
|
. S FOUND=FOUND(1)
|
|
E D
|
|
. W ! F I=1:1:FOUND W !?5,I,". ",$$GET1^DIQ(52,FOUND(I),.01),?25,$$GET1^DIQ(52,FOUND(I),6)
|
|
. W ! S DIR(0)="NA^1:"_FOUND,DIR("A")="Select one: ",DIR("B")=1
|
|
. D ^DIR I $D(DIRUT) S FOUND=-1 Q
|
|
. S FOUND=FOUND(Y)
|
|
;
|
|
Q FOUND
|