| 1 | LR175P ;DALISC/SED - LR*5.2*175 PATCH POST INIT ROUTINE ; 5/1/98
|
|---|
| 2 | ;;5.2;LAB SERVICE;**175**;Sep 27, 1994
|
|---|
| 3 | EN ; Updates for file 69.5 that will not work with KIDS
|
|---|
| 4 | ;First enter the protocal from file 101 and enter it into 69.5
|
|---|
| 5 | REMOVE ;
|
|---|
| 6 | ;
|
|---|
| 7 | S DA=$O(^DIC(19,"B","LREPI (EPI) MANUAL RUN",0))
|
|---|
| 8 | ;
|
|---|
| 9 | I $G(DA)>0 S DIK="^DIC(19," D ^DIK S MSG="Removing Manual Run Option"
|
|---|
| 10 | E S MSG="Manual Run Option not found, must be a testing site..."
|
|---|
| 11 | D BMES^XPDUTL(MSG)
|
|---|
| 12 | K MSG,DIK,DA
|
|---|
| 13 | ;
|
|---|
| 14 | ;
|
|---|
| 15 | ;
|
|---|
| 16 | S LRPROT=0
|
|---|
| 17 | S LRPROT=$O(^ORD(101,"B","LREPI",0))
|
|---|
| 18 | I +LRPROT>0 D
|
|---|
| 19 | .;ADD ADDITIONAL INFO FOR EPI.
|
|---|
| 20 | .S LRPATH=0 F S LRPATH=$O(^LAB(69.5,LRPATH)) Q:+LRPATH'>0 D
|
|---|
| 21 | ..W !,LRPATH
|
|---|
| 22 | ..Q:$P($G(^LAB(69.5,LRPATH,0)),U,7)'=LRPROT
|
|---|
| 23 | ..S $P(^LAB(69.5,LRPATH,0),U,3)=15 ;-->LAG TIME ENTRY
|
|---|
| 24 | S LRPROT=0
|
|---|
| 25 | S LRPROT=$O(^ORD(101,"B","LRNCH",0))
|
|---|
| 26 | I +LRPROT>0 D
|
|---|
| 27 | .K DD
|
|---|
| 28 | .S DIC="^LAB(69.4,",DIC(0)="L",(DINUM,X)=LRPROT,DLAYGO=69.4
|
|---|
| 29 | .D FILE^DICN K DA,DO,DD,DIC
|
|---|
| 30 | .S MSG="Adding Protocal '"_$P(^ORD(101,LRPROT,0),U,1)_"' to the "
|
|---|
| 31 | .S MSG=MSG_"LAB SEARCH/EXTRACT File (69.5)"
|
|---|
| 32 | .D BMES^XPDUTL(MSG) K MSG
|
|---|
| 33 | .S $P(^LAB(69.4,LRPROT,0),U,3)="32000"
|
|---|
| 34 | .S $P(^LAB(69.4,LRPROT,0),U,5)="National Center for Health Promotion"
|
|---|
| 35 | .; Add cholesterol and pap
|
|---|
| 36 | . D KLIK
|
|---|
| 37 | .; NOW ADD THE INFO TO FILE 69.5
|
|---|
| 38 | .;
|
|---|
| 39 | .S LRPATH=$O(^LAB(69.5,"B","NCH CHOLESTEROL",0))
|
|---|
| 40 | .I +LRPATH'>0 D BMES^XPDUTL("Unable to add a NCH to the LAB SEARCH/EXTRACT File (69.5)") Q
|
|---|
| 41 | .S $P(^LAB(69.5,LRPATH,0),U,7)=LRPROT,$P(^LAB(69.5,LRPATH,0),U,9)=50
|
|---|
| 42 | . ;-->Enter Lag time, cycle and PTF
|
|---|
| 43 | . D FILL
|
|---|
| 44 | .S LRPATH=$O(^LAB(69.5,"B","NCH PAP SMEAR",0))
|
|---|
| 45 | .I +LRPATH'>0 D BMES^XPDUTL("Unable to add a NCH to the LAB SEARCH/EXTRACT File (69.5)") Q
|
|---|
| 46 | .S $P(^LAB(69.5,LRPATH,0),U,7)=LRPROT,$P(^LAB(69.5,LRPATH,0),U,9)=51
|
|---|
| 47 | . ;-->Enter Lag time, cycle and PTF
|
|---|
| 48 | . D FILL
|
|---|
| 49 | S LRPROT=$O(^ORD(101,"B","LREPI",0))
|
|---|
| 50 | I +LRPROT>0 D
|
|---|
| 51 | .Q:'$D(^LAB(69.4,LRPROT,0))
|
|---|
| 52 | .S $P(^LAB(69.4,LRPROT,0),U,5)="Emerging Pathogens Initiative (EPI)"
|
|---|
| 53 | .S $P(^LAB(69.4,LRPROT,0),U,4)=1
|
|---|
| 54 | ;
|
|---|
| 55 | SITE ;ENTER PRIMARY SITE NUMBER TO HL7 APLICATION
|
|---|
| 56 | S LA7VS=$$PRIM^VASITE(DT) I $G(LA7VS)'="" D
|
|---|
| 57 | .S LA7VS=$$SITE^VASITE(DT,LA7VS)
|
|---|
| 58 | .S PRIMARY=$P(LA7VS,U,3)
|
|---|
| 59 | .Q:+PRIMARY'>0
|
|---|
| 60 | .S LRAPP=$O(^HL(771,"B","NCH-LAB",0))
|
|---|
| 61 | .Q:+LRAPP'>0
|
|---|
| 62 | .Q:'$D(^HL(771,LRAPP,0))
|
|---|
| 63 | .S $P(^HL(771,LRAPP,0),U,3)=PRIMARY
|
|---|
| 64 | EXIT K LRPATH,INT,X,Y,DIC,DD,LRPROT
|
|---|
| 65 | Q
|
|---|
| 66 | ;
|
|---|
| 67 | KLIK ;
|
|---|
| 68 | CHK ;
|
|---|
| 69 | ; ARE THEY THERE?
|
|---|
| 70 | S LRPATH=$O(^LAB(69.5,"B","NCH CHOLESTEROL",0)) Q:+LRPATH>0
|
|---|
| 71 | S LRPATH=$O(^LAB(69.5,"B","NCH PAP SMEAR",0)) Q:+LRPATH>0
|
|---|
| 72 | ;
|
|---|
| 73 | F X="NCH CHOLESTEROL","NCH PAP SMEAR" D
|
|---|
| 74 | . S DA=$P(^LAB(69.5,0),U,3)+1
|
|---|
| 75 | . S DIC="^LAB(69.5,"
|
|---|
| 76 | . S DIC(0)="L" S DLAYGO=69.5
|
|---|
| 77 | . D FILE^DICN K DD,DO,DIC,DA
|
|---|
| 78 | ;
|
|---|
| 79 | ;
|
|---|
| 80 | Q
|
|---|
| 81 | FILL ;
|
|---|
| 82 | ; LAG CYCLE PTF 0=YES
|
|---|
| 83 | ; /\ /\ /\
|
|---|
| 84 | ; ^LAB(69.5,16,0) = NCH CHOLESTEROL^0^7^2980525^D^^4576^0^50
|
|---|
| 85 | ;
|
|---|
| 86 | S $P(^LAB(69.5,LRPATH,0),U,3)=10
|
|---|
| 87 | S $P(^LAB(69.5,LRPATH,0),U,5)="D"
|
|---|
| 88 | S $P(^LAB(69.5,LRPATH,0),U,8)=1
|
|---|
| 89 | ;
|
|---|
| 90 | Q
|
|---|
