| 1 | LR7OV3 ;slc/dcm - Update file 60 with Blood Component Request (66.9) ;8/11/97
|
|---|
| 2 | ;;5.2;LAB SERVICE;**121**;Sep 27, 1994
|
|---|
| 3 | ;
|
|---|
| 4 | EN ;Start here to load Blood Product Requests from file 66.9
|
|---|
| 5 | N IFN,IFN1,IFN2,X,X1,Y,SPEC,CTR,LAST,DIK,DA,EDIT,RCOM
|
|---|
| 6 | I $O(^LAB(60,"B","TRANSFUSION REQUEST",0)) S X=$O(^(0)),SPEC=$P(^LAB(60,X,0),"^",9)
|
|---|
| 7 | I '$G(SPEC) S SPEC=$O(^LAB(62,"B","BLOOD",0))
|
|---|
| 8 | S EDIT=$O(^LAB(62.07,"B","LRBLSCREEN",0)),RCOM=$O(^LAB(62.07,"B","TRANSFUSION",0))
|
|---|
| 9 | LOCK L +^LAB(60):360 G:'$T LOCK
|
|---|
| 10 | S IFN=0,LAST=$P(^LAB(60,0),"^",3,4) F S IFN=$O(^LAB(66.9,IFN)) Q:IFN<1 S X=^(IFN,0) I '$D(^LAB(60,"B",$P(X,"^"))) D
|
|---|
| 11 | . S IFN1=$S(+$P(^LAB(60,0),"^",3)<1100:+$P(^(0),"^",3),1:1100) F Q:'$D(^LAB(60,IFN1)) S IFN1=IFN1+1
|
|---|
| 12 | . S LAST=(+IFN1)_"^"_($P(LAST,"^",2)+1)
|
|---|
| 13 | . S ^LAB(60,IFN1,0)=$P(X,"^")_"^^I^BB^^^^1^"_SPEC_"^^^^^"_EDIT_"^^1^0^9^"_RCOM,^(.1)="BP-"_$E($P(X,"^"),1,4),^(12)=IFN I SPEC S ^(3,0)="^60.03PAI^1^1",^(1,0)=SPEC_"^^^10",^LAB(60,IFN1,3,"AB",SPEC,1)="",^LAB(60,IFN1,3,"B",SPEC,1)=""
|
|---|
| 14 | . I $G(DUZ(2)) S ^LAB(60,IFN1,8,0)="^60.11PA^"_DUZ(2)_"^1",^LAB(60,IFN1,8,DUZ(2),0)=DUZ(2)_"^"_$O(^LRO(68,"B","BLOOD BANK",0))
|
|---|
| 15 | . S DA=IFN1,DIK="^LAB(60," D IX^DIK
|
|---|
| 16 | S $P(^LAB(60,0),"^",3,4)=LAST L -^LAB(60)
|
|---|
| 17 | Q
|
|---|
| 18 | DEL ;Delete components out of file 60 (for testing only)
|
|---|
| 19 | N IFN,X,DA,DIK
|
|---|
| 20 | S IFN=0 F S IFN=$O(^LAB(60,IFN)) Q:IFN<1 I $D(^(IFN,12)),+^(12) S DA=IFN,DIK="^LAB(60," D ^DIK W "."
|
|---|
| 21 | Q
|
|---|
| 22 | POS ;Post init for future blood bank patch, when/if ordering components
|
|---|
| 23 | N LRCHK
|
|---|
| 24 | S LRCHK=$$NEWCP^XPDUTL("P1","P1^LR7OV3")
|
|---|
| 25 | Q
|
|---|
| 26 | P1 ;Post init entry point
|
|---|
| 27 | D BMES^XPDUTL("Now adding Blood Component Requests to Lab Test file...")
|
|---|
| 28 | D EN
|
|---|
| 29 | D MES^XPDUTL("Done adding Blood Component Requests")
|
|---|
| 30 | Q
|
|---|
