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

LRVRMI2.m

Go to the documentation of this file.
  1. LRVRMI2 ;DALOI/STAFF - LAH/TMP TO FILE #63 ;09/07/16 08:07
  1. ;;5.2;LAB SERVICE;**350,427,474**;Sep 27, 1994;Build 14
  1. ;
  1. ; Continuation of LRVRMI4 and is used for extracting results from the LAH global and storing it into LAB DATA FILE (#63).
  1. ;
  1. Q
  1. ;
  1. N7 ; Process Parasite Remarks
  1. N DIERR,IEN,LRCMT,LRFDA,LRFDAIEN,LRIEN,LRIENS,LRMSG,LRPL,LRX,X,STAT
  1. S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,7,0))
  1. S LRPL=$P(LRX,"^"),STAT=$P(LRX,"^",4)
  1. D BLDSTAT^LRVRMI4A(63.05,15,STAT,.LRSTATUS)
  1. M LRCMT=^LR(LRDFN,"MI",LRIDT,7)
  1. ;
  1. S IEN=0
  1. F S IEN=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,7,IEN)) Q:IEN<1 D ;
  1. . S LRX=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,7,IEN,0),LRX=$S(LRX'="":LRX,1:" ")
  1. . I LRX'=" ",$$DUPCHK^LRVRMI3(LRLL,LRPROF,.LRCMT,LRX) Q
  1. . S LRIEN="+"_IEN_","_LRIDT_","_LRDFN_","
  1. . S LRFDA(7,63.36,LRIEN,.01)=LRX
  1. ;
  1. I $D(LRFDA) D
  1. . D UPDATE^DIE("","LRFDA(7)","LRFDAIEN","LRMSG")
  1. . S IEN=0
  1. . F S IEN=$O(LRFDAIEN(IEN)) Q:'IEN I $G(LRPL) D SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_",7,"_LRFDAIEN(IEN),LRPL)
  1. ;
  1. K LRFDA,LRIEN,LRMSG,DIERR
  1. S LRIEN=LRIDT_","_LRDFN_","
  1. I LRINTYPE=10 S LRFDA(7,63.05,LRIEN,14)=LRNOW
  1. S LRFDA(7,63.05,LRIEN,15.5)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ))
  1. D FILE^DIE("","LRFDA(7)","LRMSG")
  1. S LRRPTAPP=1
  1. Q
  1. ;
  1. ;
  1. N10 ; Process Mycology Remarks
  1. N DIERR,IEN,LRCMT,LRFDA,LRIEN,LRIENS,LRMSG,LRPL,LRX,STAT
  1. S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,10,0))
  1. S LRPL=$P(LRX,"^"),STAT=$P(LRX,U,4)
  1. D BLDSTAT^LRVRMI4A(63.05,19,STAT,.LRSTATUS)
  1. M LRCMT=^LR(LRDFN,"MI",LRIDT,10)
  1. ;
  1. S IEN=0
  1. F S IEN=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,10,IEN)) Q:IEN<1 D
  1. . S LRX=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,10,IEN,0),LRX=$S(LRX'="":LRX,1:" ")
  1. . I LRX'=" ",$$DUPCHK^LRVRMI3(LRLL,LRPROF,.LRCMT,LRX) Q
  1. . S LRIEN="+"_IEN_","_LRIDT_","_LRDFN_","
  1. . S LRFDA(10,63.38,LRIEN,.01)=LRX
  1. I $D(LRFDA) D
  1. . D UPDATE^DIE("","LRFDA(10)","LRFDAIEN","LRMSG")
  1. . S IEN=0
  1. . F S IEN=$O(LRFDAIEN(IEN)) Q:'IEN I $G(LRPL) D SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_",10,"_LRFDAIEN(IEN),LRPL)
  1. ;
  1. K LRFDA,LRIEN,LRMSG,DIERR
  1. S LRIEN=LRIDT_","_LRDFN_","
  1. I LRINTYPE=10 S LRFDA(10,63.05,LRIEN,18)=LRNOW
  1. S LRFDA(10,63.05,LRIEN,19.5)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ))
  1. D FILE^DIE("","LRFDA(10)","LRMSG")
  1. S LRRPTAPP=1
  1. Q
  1. ;
  1. ;
  1. N13 ; Process TB Rpt Remarks
  1. N DIERR,IEN,LRCMT,LRFDA,LRIEN,LRIENS,LRMSG,LRPL,LRX,STAT
  1. S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,13,0))
  1. S LRPL=$P(LRX,"^"),STAT=$P(LRX,U,4)
  1. D BLDSTAT^LRVRMI4A(63.05,23,STAT,.LRSTATUS)
  1. M LRCMT=^LR(LRDFN,"MI",LRIDT,13)
  1. ;
  1. S IEN=0
  1. F S IEN=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,13,IEN)) Q:IEN<1 D
  1. . S LRX=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,13,IEN,0),LRX=$S(LRX'="":LRX,1:" ")
  1. . I LRX'=" ",$$DUPCHK^LRVRMI3(LRLL,LRPROF,.LRCMT,LRX) Q
  1. . S LRIEN="+"_IEN_","_LRIDT_","_LRDFN_","
  1. . S LRFDA(13,63.41,LRIEN,.01)=LRX
  1. I $D(LRFDA) D
  1. . D UPDATE^DIE("","LRFDA(13)","LRFDAIEN","LRMSG")
  1. . S IEN=0
  1. . F S IEN=$O(LRFDAIEN(IEN)) Q:'IEN I $G(LRPL) D SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_",13,"_LRFDAIEN(IEN),LRPL)
  1. ;
  1. K LRFDA,LRIEN,LRMSG,DIERR
  1. S LRIEN=LRIDT_","_LRDFN_","
  1. I LRINTYPE=10 S LRFDA(13,63.05,LRIEN,22)=LRNOW
  1. S LRFDA(13,63.05,LRIEN,25.5)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ))
  1. D FILE^DIE("","LRFDA(13)","LRMSG")
  1. S LRRPTAPP=1
  1. Q
  1. ;
  1. ;
  1. N15 ; Mycology smear/prep
  1. N DIERR,IEN,LRCMT,LRFDA,LRIEN,LRIENS,LRMSG,LRPL,LRX
  1. S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,15,0))
  1. S LRPL=$P(LRX,"^"),STAT=$P(LRX,U,4)
  1. D BLDSTAT^LRVRMI4A(63.05,19,STAT,.LRSTATUS)
  1. M LRCMT=^LR(LRDFN,"MI",LRIDT,15)
  1. ;
  1. S IEN=0
  1. F S IEN=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,15,IEN)) Q:IEN<1 D ;
  1. . S LRX=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,15,IEN,0),LRX=$S(LRX'="":LRX,1:" ")
  1. . I LRX'=" ",$$DUPCHK^LRVRMI3(LRLL,LRPROF,.LRCMT,LRX) Q
  1. . S LRIEN="+"_IEN_","_LRIDT_","_LRDFN_","
  1. . S LRFDA(15,63.371,LRIEN,.01)=LRX
  1. ;
  1. I $D(LRFDA) D
  1. . D UPDATE^DIE("","LRFDA(15)","LRFDAIEN","LRMSG")
  1. . S IEN=0
  1. . F S IEN=$O(LRFDAIEN(IEN)) Q:'IEN I $G(LRPL) D SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_",15,"_LRFDAIEN(IEN),LRPL)
  1. ;
  1. K LRFDA,LRIEN,LRMSG,DIERR
  1. S LRIEN=LRIDT_","_LRDFN_","
  1. I LRINTYPE=10 S LRFDA(15,63.05,LRIEN,18)=LRNOW
  1. S LRFDA(15,63.05,LRIEN,19.5)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ))
  1. D FILE^DIE("","LRFDA(15)","LRMSG")
  1. S LRRPTAPP=1
  1. Q
  1. ;
  1. ;
  1. N18 ; Process Virology Rpt Remarks
  1. N DIERR,IEN,LRCMT,LRFDA,LRIEN,LRIENS,LRMSG,LRPL,LRX,STAT
  1. ;
  1. S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,18,0))
  1. S LRPL=$P(LRX,"^"),STAT=$P(LRX,U,4)
  1. D BLDSTAT^LRVRMI4A(63.05,34,STAT,.LRSTATUS)
  1. M LRCMT=^LR(LRDFN,"MI",LRIDT,18)
  1. ;
  1. S IEN=0
  1. F S IEN=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,18,IEN)) Q:IEN<1 D ;
  1. . S LRX=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,18,IEN,0),LRX=$S(LRX'="":LRX,1:" ")
  1. . I LRX'=" ",$$DUPCHK^LRVRMI3(LRLL,LRPROF,.LRCMT,LRX) Q
  1. . S LRIEN="+"_IEN_","_LRIDT_","_LRDFN_","
  1. . S LRFDA(18,63.44,LRIEN,.01)=LRX
  1. I $D(LRFDA) D
  1. . D UPDATE^DIE("","LRFDA(18)","LRFDAIEN","LRMSG")
  1. . S IEN=0
  1. . F S IEN=$O(LRFDAIEN(IEN)) Q:'IEN I $G(LRPL) D SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_",18,"_LRFDAIEN(IEN),LRPL)
  1. ;
  1. K LRFDA,LRIEN,LRMSG,DIERR
  1. S LRIEN=LRIDT_","_LRDFN_","
  1. I LRINTYPE=10 S LRFDA(18,63.05,LRIEN,33)=LRNOW
  1. S LRFDA(18,63.05,LRIEN,35)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ))
  1. D FILE^DIE("","LRFDA(18)","LRMSG")
  1. S LRRPTAPP=1
  1. Q
  1. ;
  1. ;
  1. ; Start by getting the demographic data from LAH
  1. S EOL=$G(^LAH(LWL,1,ISQN,.1,"OBR","EOL"))
  1. S FID=$G(^LAH(LWL,1,ISQN,.1,"OBR","FID"))
  1. S ORCDT=$G(^LAH(LWL,1,ISQN,.1,"OBR","ORCDT"))
  1. S ORDNLT=$G(^LAH(LWL,1,ISQN,.1,"OBR","ORDNLT"))
  1. S ORDP=$G(^LAH(LWL,1,ISQN,.1,"OBR","ORDP"))
  1. S PEB=$G(^LAH(LWL,1,ISQN,.1,"OBR","PEB"))
  1. S PVB=$G(^LAH(LWL,1,ISQN,.1,"OBR","PVB"))
  1. S SID=$G(^LAH(LWL,1,ISQN,.1,"OBR","SID"))
  1. S DFN=$G(^LAH(LWL,1,ISQN,.1,"PID","DFN"))
  1. S DOB=$G(^LAH(LWL,1,ISQN,.1,"PID","DOB"))
  1. S ICN=$G(^LAH(LWL,1,ISQN,.1,"PID","ICN"))
  1. S LRTDFN=$G(^LAH(LWL,1,ISQN,.1,"PID","LRTDFN"))
  1. S PNM=$G(^LAH(LWL,1,ISQN,.1,"PID","PNM"))
  1. S SEX=$G(^LAH(LWL,1,ISQN,.1,"PID","SEX"))
  1. S SSN=$G(^LAH(LWL,1,ISQN,.1,"PID","SSN"))
  1. S LRUID=$G(^LAH(LWL,1,ISQN,.3))
  1. Q