Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LR175P

LR175P.m

Go to the documentation of this file. 
  1. LR175P ;DALISC/SED - LR*5.2*175 PATCH POST INIT ROUTINE ; 5/1/98
  1.  ;;5.2T9;LR;**1018**;Nov 17, 2004
  1.  ;;5.2;LAB SERVICE;**175**;Sep 27, 1994
  1. EN ; Updates for file 69.5 that will not work with KIDS
  1.  ;First enter the protocal from file 101 and enter it into 69.5
  1. REMOVE ;
  1.  ;
  1.  S DA=$O(^DIC(19,"B","LREPI (EPI) MANUAL RUN",0))
  1.  ;
  1.  I $G(DA)>0 S DIK="^DIC(19," D ^DIK S MSG="Removing Manual Run Option"
  1.  E  S MSG="Manual Run Option not found, must be a testing site..."
  1.  D BMES^XPDUTL(MSG)
  1.  K MSG,DIK,DA
  1.  ;
  1.  ;
  1.  ;
  1.  S LRPROT=0
  1.  S LRPROT=$O(^ORD(101,"B","LREPI",0))
  1.  I +LRPROT>0 D
  1.  .;ADD ADDITIONAL INFO FOR EPI.
  1.  .S LRPATH=0 F  S LRPATH=$O(^LAB(69.5,LRPATH)) Q:+LRPATH'>0  D
  1.  ..W !,LRPATH
  1.  ..Q:$P($G(^LAB(69.5,LRPATH,0)),U,7)'=LRPROT
  1.  ..S $P(^LAB(69.5,LRPATH,0),U,3)=15 ;-->LAG TIME ENTRY
  1.  S LRPROT=0
  1.  S LRPROT=$O(^ORD(101,"B","LRNCH",0))
  1.  I +LRPROT>0 D
  1.  .K DD
  1.  .S DIC="^LAB(69.4,",DIC(0)="L",(DINUM,X)=LRPROT,DLAYGO=69.4
  1.  .D FILE^DICN K DA,DO,DD,DIC
  1.  .S MSG="Adding Protocal '"_$P(^ORD(101,LRPROT,0),U,1)_"' to the "
  1.  .S MSG=MSG_"LAB SEARCH/EXTRACT File (69.5)"
  1.  .D BMES^XPDUTL(MSG) K MSG
  1.  .S $P(^LAB(69.4,LRPROT,0),U,3)="32000"
  1.  .S $P(^LAB(69.4,LRPROT,0),U,5)="National Center for Health Promotion"
  1.  .;  Add cholesterol and pap
  1.  .  D KLIK
  1.  .;  NOW ADD THE INFO TO FILE 69.5
  1.  .;
  1.  .S LRPATH=$O(^LAB(69.5,"B","NCH CHOLESTEROL",0))
  1.  .I +LRPATH'>0 D BMES^XPDUTL("Unable to add a NCH to the LAB SEARCH/EXTRACT File (69.5)") Q
  1.  .S $P(^LAB(69.5,LRPATH,0),U,7)=LRPROT,$P(^LAB(69.5,LRPATH,0),U,9)=50
  1.  . ;-->Enter Lag time, cycle and PTF
  1.  . D FILL
  1.  .S LRPATH=$O(^LAB(69.5,"B","NCH PAP SMEAR",0))
  1.  .I +LRPATH'>0 D BMES^XPDUTL("Unable to add a NCH to the LAB SEARCH/EXTRACT File (69.5)") Q
  1.  .S $P(^LAB(69.5,LRPATH,0),U,7)=LRPROT,$P(^LAB(69.5,LRPATH,0),U,9)=51
  1.  . ;-->Enter Lag time, cycle and PTF
  1.  . D FILL
  1.  S LRPROT=$O(^ORD(101,"B","LREPI",0))
  1.  I +LRPROT>0 D
  1.  .Q:'$D(^LAB(69.4,LRPROT,0))
  1.  .S $P(^LAB(69.4,LRPROT,0),U,5)="Emerging Pathogens Initiative (EPI)"
  1.  .S $P(^LAB(69.4,LRPROT,0),U,4)=1
  1.  ;
  1. SITE ;ENTER PRIMARY SITE NUMBER TO HL7 APLICATION
  1.  S LA7VS=$$PRIM^VASITE(DT) I $G(LA7VS)'="" D
  1.  .S LA7VS=$$SITE^VASITE(DT,LA7VS)
  1.  .S PRIMARY=$P(LA7VS,U,3)
  1.  .Q:+PRIMARY'>0
  1.  .S LRAPP=$O(^HL(771,"B","NCH-LAB",0))
  1.  .Q:+LRAPP'>0
  1.  .Q:'$D(^HL(771,LRAPP,0))
  1.  .S $P(^HL(771,LRAPP,0),U,3)=PRIMARY
  1. EXIT K LRPATH,INT,X,Y,DIC,DD,LRPROT
  1.  Q
  1.  ;
  1. KLIK ;
  1. CHK ;
  1.  ;  ARE THEY THERE?
  1.  S LRPATH=$O(^LAB(69.5,"B","NCH CHOLESTEROL",0)) Q:+LRPATH>0
  1.  S LRPATH=$O(^LAB(69.5,"B","NCH PAP SMEAR",0)) Q:+LRPATH>0
  1.  ;
  1.  F X="NCH CHOLESTEROL","NCH PAP SMEAR" D
  1.  .  S DA=$P(^LAB(69.5,0),U,3)+1
  1.  .  S DIC="^LAB(69.5,"
  1.  .  S DIC(0)="L" S DLAYGO=69.5
  1.  .  D FILE^DICN K DD,DO,DIC,DA
  1.  ;
  1.  ;
  1.  Q
  1. FILL ;
  1.  ;                                     LAG       CYCLE   PTF 0=YES
  1.  ;                                     /\        /\      /\
  1.  ;  ^LAB(69.5,16,0) = NCH CHOLESTEROL^0^7^2980525^D^^4576^0^50
  1.  ;
  1.  S $P(^LAB(69.5,LRPATH,0),U,3)=10
  1.  S $P(^LAB(69.5,LRPATH,0),U,5)="D"
  1.  S $P(^LAB(69.5,LRPATH,0),U,8)=1
  1.  ;
  1.  Q