source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LR7OV3.m@ 1258

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

initial load of WorldVistAEHR
File size: 1.6 KB
RevLine 
[613]1LR7OV3 ;slc/dcm - Update file 60 with Blood Component Request (66.9) ;8/11/97
2 ;;5.2;LAB SERVICE;**121**;Sep 27, 1994
3 ;
4EN ;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))
9LOCK 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
18DEL ;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
22POS ;Post init for future blood bank patch, when/if ordering components
23 N LRCHK
24 S LRCHK=$$NEWCP^XPDUTL("P1","P1^LR7OV3")
25 Q
26P1 ;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
Note: See TracBrowser for help on using the repository browser.