30 lines
1.1 KiB
Mathematica
30 lines
1.1 KiB
Mathematica
|
PSJBCMA3 ;BIR/JLC-ADD BCMA STATUS UPDATE TO PS(55 ;21 FEB 01
|
||
|
|
;;5.0; INPATIENT MEDICATIONS ;**58,91**;16 DEC 97
|
||
|
|
;
|
||
|
|
;Reference to ^PS(55 is supported by DBIA 2191
|
||
|
|
;
|
||
|
|
EN(DFN,ON,BCID,STATUS,DATE) ;
|
||
|
|
I '$D(DFN)!'$D(ON)!'$D(BCID)!'$D(STATUS)!'$D(DATE) Q
|
||
|
|
I '$D(^PS(55,DFN,"IV",ON)) Q
|
||
|
|
N PSJBLN,UON
|
||
|
|
D SEARCH(ON)
|
||
|
|
I $D(PSJBLN) S UON=ON G UPDATE
|
||
|
|
S (PON,OPON)=ON F S PON=$P(^PS(55,DFN,"IV",PON,2),"^",5) S:PON["P" PON=$$PNDV(PON) S PON=+PON Q:'PON Q:PON=OPON D SEARCH(PON) Q:$D(PSJBLN) S OPON=PON
|
||
|
|
I $D(PSJBLN) S UON=PON G UPDATE
|
||
|
|
Q
|
||
|
|
SEARCH(ON) S X1=0 F S X1=$O(^PS(55,DFN,"IV",ON,"BCMA",X1)) Q:X1=""!(X1'?1.N) I $D(^PS(55,DFN,"IVBCMA",X1)),$P(^(X1,0),"^")=BCID S PSJBLN=X1 Q
|
||
|
|
Q
|
||
|
|
UPDATE K DA,DR,DIE S DIE="^PS(55,"_DFN_",""IVBCMA"",",DA=PSJBLN,DA(1)=DFN,DR="1////"_DATE_";2////"_STATUS
|
||
|
|
I STATUS="" S DR="1///@;2///@"
|
||
|
|
D ^DIE
|
||
|
|
K DA,DR,DIE S DIE="^PS(55,"_DFN_",""IV"",",DA=UON,DA(1)=DFN,DR="144////"_STATUS_";145////"_BCID
|
||
|
|
I STATUS="" S DR="144///@;145///@"
|
||
|
|
D ^DIE
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
PNDV(PNDON) ;
|
||
|
|
Q:PNDON'["P" ""
|
||
|
|
N PRV S PRV=""
|
||
|
|
F S PRV=$P($G(^PS(53.1,+PNDON,0)),"^",25) Q:PRV=""!(PRV["V") S PNDON=PRV
|
||
|
|
Q $S(PRV["V":PRV,1:"")
|