| [613] | 1 | PSJBCMA3 ;BIR/JLC-ADD BCMA STATUS UPDATE TO PS(55 ;21 FEB 01
|
|---|
| 2 | ;;5.0; INPATIENT MEDICATIONS ;**58,91**;16 DEC 97
|
|---|
| 3 | ;
|
|---|
| 4 | ;Reference to ^PS(55 is supported by DBIA 2191
|
|---|
| 5 | ;
|
|---|
| 6 | EN(DFN,ON,BCID,STATUS,DATE) ;
|
|---|
| 7 | I '$D(DFN)!'$D(ON)!'$D(BCID)!'$D(STATUS)!'$D(DATE) Q
|
|---|
| 8 | I '$D(^PS(55,DFN,"IV",ON)) Q
|
|---|
| 9 | N PSJBLN,UON
|
|---|
| 10 | D SEARCH(ON)
|
|---|
| 11 | I $D(PSJBLN) S UON=ON G UPDATE
|
|---|
| 12 | 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
|
|---|
| 13 | I $D(PSJBLN) S UON=PON G UPDATE
|
|---|
| 14 | Q
|
|---|
| 15 | 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
|
|---|
| 16 | Q
|
|---|
| 17 | UPDATE K DA,DR,DIE S DIE="^PS(55,"_DFN_",""IVBCMA"",",DA=PSJBLN,DA(1)=DFN,DR="1////"_DATE_";2////"_STATUS
|
|---|
| 18 | I STATUS="" S DR="1///@;2///@"
|
|---|
| 19 | D ^DIE
|
|---|
| 20 | K DA,DR,DIE S DIE="^PS(55,"_DFN_",""IV"",",DA=UON,DA(1)=DFN,DR="144////"_STATUS_";145////"_BCID
|
|---|
| 21 | I STATUS="" S DR="144///@;145///@"
|
|---|
| 22 | D ^DIE
|
|---|
| 23 | Q
|
|---|
| 24 | ;
|
|---|
| 25 | PNDV(PNDON) ;
|
|---|
| 26 | Q:PNDON'["P" ""
|
|---|
| 27 | N PRV S PRV=""
|
|---|
| 28 | F S PRV=$P($G(^PS(53.1,+PNDON,0)),"^",25) Q:PRV=""!(PRV["V") S PNDON=PRV
|
|---|
| 29 | Q $S(PRV["V":PRV,1:"")
|
|---|
