source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJBCMA3.m@ 1259

Last change on this file since 1259 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.1 KB
Line 
1PSJBCMA3 ;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 ;
6EN(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
15SEARCH(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
17UPDATE 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 ;
25PNDV(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:"")
Note: See TracBrowser for help on using the repository browser.