source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRBLDLG.m@ 1006

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

initial load of WorldVistAEHR

File size: 4.2 KB
Line 
1LRBLDLG ;AVAMC/REG/CYM - BB DONOR LOG-IN ;1/29/97 12:48 ;
2 ;;5.2;LAB SERVICE;**90,247**;Sep 27, 1994
3 ;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
4 D V^LRU S LR("SSN")=$P($G(^LAB(69.9,1,8,1,0)),U,5),LR("LRBLDLG")="",X="BLOOD BANK" D ^LRUTL G:Y=-1 END D EN1^LRBLY,D^LRBLU G:'$D(X) END
5 W @IOF,?30,"Log-in donor visits",! I LRCAPA D Z^LRBLWD G:$D(LRX) END
6 S %DT="AEX",%DT(0)="-N",%DT("A")="Enter DONATION DATE: TODAY// " D ^%DT K %DT I X="" S Y=DT W LRH(0)
7 G:Y<1 END S (LRAD,X)=Y,LRI=9999999-Y D DW^%DTC W " ",X S:'$D(^LRO(69.2,LRAA,5,0)) ^(0)="^69.24A^0^0"
8 W !!,"For a group of donors COLLECTION SITE & DONATION GROUP need be entered once.",!,"If not desired just press 'RETURN' key after the following two prompts.",!!
9 S DIC=65.4,DIC("S")="I $P(^(0),U,2)[""C""",DIC("A")="Enter COLLECTION SITE: ",DIC(0)="AEQM" D ^DIC K DIC G:X[U END S LR=$S(Y=-1:"",1:+Y)
10 S DIC=65.4,DIC(0)="AEQM",DIC("A")="Enter DONATION GROUP: ",DIC("S")="I $P(^(0),U,2)[""G""" D ^DIC K DIC G:X[U END S LR(1)=$S(Y=-1:"",1:+Y)
11DNR K LRC,DIC,DIE,DR,DA,LR("CK")
12 W !! S (DIC,DIE)="^LRE(",DIC(0)="AEQLMZ",DLAYGO=65,D="B^C^"_$S("NAFARMY"[DUZ("AG")&(DUZ("AG")]""):"G4^G",1:"D") D MIX^DIC1 K DIC,DLAYGO G:Y<1 END
13 S (LRQ,DA)=+Y,(LRP,LRP(0))=$P(Y,U,2) I $P(Y,U,3) D ^LRBLD G:'$D(DA) DNR D ADD G OK
14 S B=0 I $D(^LRE(DA,9)) S DIWR=IOM-5,DIWL=5,DIWF="W" S A=0 F B=0:1 S A=$O(^LRE(DA,9,A)) Q:'A W:'B ! S X=^(A,0) D ^DIWP
15 D:B ^DIWW W !,"Is this the Donor " S %=1 D YN^LRU G:%'=1 DNR
16OK G:'$D(^LRE(LRQ,0)) DNR S X=^(0),X1=DT,(X2,LRD)=$P(X,"^",3),LRB=$E(X2,4,5)_"-"_$E(X2,6,7)_"-"_$E(X2,2,3),LRS(2)=$P(X,"^",13) D ^%DTC S X=X\365.25
17 I X<18 W $C(7),!!,"Age:",X," Does donor have permission to donate " S %=1 D YN^LRU G:%'=1 DNR
18 I X>64 W $C(7)," Age: ",X,!?7,"Does donor have physician permission to donate " S %=1 D YN^LRU G:%'=1 DNR
19 W @IOF S (DIE,DIC)="^LRE(",DA=LRQ,DR="0;1;2;4" D EN^DIQ
20 I $P(^LRE(LRQ,0),U,10) W $C(7),!!,$P(^(0),U)," permanently deferred except for autologous",!,"or therapeutic donation. If any questions see physician in charge.",!!,"Do you want autologous/therapeutic donation " S %=2 D YN^LRU G:%'=1 DNR
21 I LR("SSN"),$P(^LRE(LRQ,0),U,13)="" S DA=LRQ,DR=.13,DIE="^LRE(" D ^DIE
22 W !,"EDIT above information: " S %=2 D YN^LRU G:%<1 DNR I %=1 K DR D CK^LRU G:$D(LR("CK")) DNR S DR="[LRBLDEMO]" D ^DIE D FRE^LRU G OK
23 S X=$O(^LRE(LRQ,5,0)) I X S Y=+^(X,0) D D^LRU W " Last visit: ",Y
24 S:'$D(^LRE(LRQ,5,0)) ^(0)="^65.54DA^^" I '$D(^(LRI,0)) L +^LRE(LRQ,5) S X=$P(^LRE(LRQ,5,0),"^",4),^(0)="^65.54DA^"_LRI_"^"_(X+1),^(LRI,0)=LRAD_"^^^^^"_LR_"^"_LR(1),^LRE("AD",$P(LRAD,"."),LRQ)="" L -^LRE(LRQ,5)
25 S (LR(65.54,1),LR(65.54,1.1),LRA)="",DA=LRI,DA(1)=LRQ,DIE="^LRE(LRQ,5,"
26A S DR=".02;.03;.13//^S X=""NOW"";1//^S X=""WHOLE BLOOD"";S LR(65.54,1)=X;S:X=""N"" Y=2;1.1//^S X=""HOMOLOGOUS"";S LR(65.54,1.1)=X;S:X=""A"" LRA=LRP;S LRT=X;S:""AD""'[X Y=0;W !!;1.2//^S X=LRA;S Y=0;2"
27 D ^DIE I $D(Y) G:$P(^LRE(LRQ,5,LRI,0),U,4)]"" DNR W $C(7),!!,"Delete all data from this donation " S %=2 D YN^LRU G:%'=1 A S DA=LRI,DIK="^LRE(LRQ,5," D ^DIK K DIK G DNR
28 I LR(65.54,1.1)="A",'$P(^LRE(LRQ,5,LRI,0),U,12) W $C(7),!!,"Autologous donation and RESTRICTED FOR: field not entered.",!,"Delete all data from this donation " S %=2 D YN^LRU G:%'=1 A S DA=LRI,DIK="^LRE(LRQ,5," D ^DIK K DIK G DNR
29 I LR(65.54,1)="N" D EN^LRBLY D:LRCAPA N^LRBLWD G DNR
30 S LR(65.54)=LR(65.54,1.1)_LR(65.54,1),X1=9999999-LRI,X2=-55 D C^%DTC S Z(1)=9999999-X
31 F X=LRI:0 S X=$O(^LRE(LRQ,5,X)) Q:'X!(X>Z(1)) S Y=$P(^(X,0),"^",2) I LR(65.54,1)="W",LR(65.54,1.1)="H",Y="W" W !!,"LAST WHOLE BLOOD DONATION " S LRC=1,(Y,Z)=+^(0) D D^LRU W Y Q
32 I $D(LRC) S X1=LRAD,X2=Z D ^%DTC I X<56 W $C(7),!!,"SORRY NOT 8 WEEKS SINCE LAST DONATION OF WHOLE BLOOD" S X1=Z,X2=56 D C^%DTC S Y=X D D^LRU W !,"COME BACK ON OR AFTER ",Y D RES D:LRCAPA N^LRBLWD G DNR
33 I LRCAPA D @(LR(65.54)_"^LRBLWD")
34 D EN^LRBLY W !,"Enter donor in list for printing registration form " S %=2 D YN^LRU G:%'=1 MORE
35 S ^LRO(69.2,LRAA,5,LRQ,0)=LRQ_"^65.5^"_LRP,^LRO(69.2,LRAA,5,"C",LRP,LRQ)="" G DNR
36MORE W !!,"Continue to enter collection information " S %=1 D YN^LRU G:%'=1 DNR
37 K DA,DR,DIE,DIC,DR,DQ S (DIC,DIE)="^LRE(",DA=LRQ,DR="[LRBLDCPN]" D ^DIE G DNR
38ADD S DR=$S(LRH(2):"[LRBLDNEWM]",1:"[LRBLDNEW]") D ^DIE Q
39RES S X=^LRE(LRQ,5,LRI,0),^(0)=$P(X,"^")_"^"_"N"_"^"_$P(X,"^",3,99) Q
40END D V^LRU Q
Note: See TracBrowser for help on using the repository browser.