- LRVRMI2 ;DALOI/STAFF - LAH/TMP TO FILE #63 ;09/07/16 08:07
- ;;5.2;LAB SERVICE;**350,427,474**;Sep 27, 1994;Build 14
- ;
- ; Continuation of LRVRMI4 and is used for extracting results from the LAH global and storing it into LAB DATA FILE (#63).
- ;
- Q
- ;
- N7 ; Process Parasite Remarks
- N DIERR,IEN,LRCMT,LRFDA,LRFDAIEN,LRIEN,LRIENS,LRMSG,LRPL,LRX,X,STAT
- S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,7,0))
- S LRPL=$P(LRX,"^"),STAT=$P(LRX,"^",4)
- D BLDSTAT^LRVRMI4A(63.05,15,STAT,.LRSTATUS)
- M LRCMT=^LR(LRDFN,"MI",LRIDT,7)
- ;
- S IEN=0
- F S IEN=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,7,IEN)) Q:IEN<1 D ;
- . S LRX=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,7,IEN,0),LRX=$S(LRX'="":LRX,1:" ")
- . I LRX'=" ",$$DUPCHK^LRVRMI3(LRLL,LRPROF,.LRCMT,LRX) Q
- . S LRIEN="+"_IEN_","_LRIDT_","_LRDFN_","
- . S LRFDA(7,63.36,LRIEN,.01)=LRX
- ;
- I $D(LRFDA) D
- . D UPDATE^DIE("","LRFDA(7)","LRFDAIEN","LRMSG")
- . S IEN=0
- . F S IEN=$O(LRFDAIEN(IEN)) Q:'IEN I $G(LRPL) D SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_",7,"_LRFDAIEN(IEN),LRPL)
- ;
- K LRFDA,LRIEN,LRMSG,DIERR
- S LRIEN=LRIDT_","_LRDFN_","
- I LRINTYPE=10 S LRFDA(7,63.05,LRIEN,14)=LRNOW
- S LRFDA(7,63.05,LRIEN,15.5)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ))
- D FILE^DIE("","LRFDA(7)","LRMSG")
- S LRRPTAPP=1
- Q
- ;
- ;
- N10 ; Process Mycology Remarks
- N DIERR,IEN,LRCMT,LRFDA,LRIEN,LRIENS,LRMSG,LRPL,LRX,STAT
- S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,10,0))
- S LRPL=$P(LRX,"^"),STAT=$P(LRX,U,4)
- D BLDSTAT^LRVRMI4A(63.05,19,STAT,.LRSTATUS)
- M LRCMT=^LR(LRDFN,"MI",LRIDT,10)
- ;
- S IEN=0
- F S IEN=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,10,IEN)) Q:IEN<1 D
- . S LRX=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,10,IEN,0),LRX=$S(LRX'="":LRX,1:" ")
- . I LRX'=" ",$$DUPCHK^LRVRMI3(LRLL,LRPROF,.LRCMT,LRX) Q
- . S LRIEN="+"_IEN_","_LRIDT_","_LRDFN_","
- . S LRFDA(10,63.38,LRIEN,.01)=LRX
- I $D(LRFDA) D
- . D UPDATE^DIE("","LRFDA(10)","LRFDAIEN","LRMSG")
- . S IEN=0
- . F S IEN=$O(LRFDAIEN(IEN)) Q:'IEN I $G(LRPL) D SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_",10,"_LRFDAIEN(IEN),LRPL)
- ;
- K LRFDA,LRIEN,LRMSG,DIERR
- S LRIEN=LRIDT_","_LRDFN_","
- I LRINTYPE=10 S LRFDA(10,63.05,LRIEN,18)=LRNOW
- S LRFDA(10,63.05,LRIEN,19.5)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ))
- D FILE^DIE("","LRFDA(10)","LRMSG")
- S LRRPTAPP=1
- Q
- ;
- ;
- N13 ; Process TB Rpt Remarks
- N DIERR,IEN,LRCMT,LRFDA,LRIEN,LRIENS,LRMSG,LRPL,LRX,STAT
- S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,13,0))
- S LRPL=$P(LRX,"^"),STAT=$P(LRX,U,4)
- D BLDSTAT^LRVRMI4A(63.05,23,STAT,.LRSTATUS)
- M LRCMT=^LR(LRDFN,"MI",LRIDT,13)
- ;
- S IEN=0
- F S IEN=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,13,IEN)) Q:IEN<1 D
- . S LRX=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,13,IEN,0),LRX=$S(LRX'="":LRX,1:" ")
- . I LRX'=" ",$$DUPCHK^LRVRMI3(LRLL,LRPROF,.LRCMT,LRX) Q
- . S LRIEN="+"_IEN_","_LRIDT_","_LRDFN_","
- . S LRFDA(13,63.41,LRIEN,.01)=LRX
- I $D(LRFDA) D
- . D UPDATE^DIE("","LRFDA(13)","LRFDAIEN","LRMSG")
- . S IEN=0
- . F S IEN=$O(LRFDAIEN(IEN)) Q:'IEN I $G(LRPL) D SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_",13,"_LRFDAIEN(IEN),LRPL)
- ;
- K LRFDA,LRIEN,LRMSG,DIERR
- S LRIEN=LRIDT_","_LRDFN_","
- I LRINTYPE=10 S LRFDA(13,63.05,LRIEN,22)=LRNOW
- S LRFDA(13,63.05,LRIEN,25.5)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ))
- D FILE^DIE("","LRFDA(13)","LRMSG")
- S LRRPTAPP=1
- Q
- ;
- ;
- N15 ; Mycology smear/prep
- N DIERR,IEN,LRCMT,LRFDA,LRIEN,LRIENS,LRMSG,LRPL,LRX
- S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,15,0))
- S LRPL=$P(LRX,"^"),STAT=$P(LRX,U,4)
- D BLDSTAT^LRVRMI4A(63.05,19,STAT,.LRSTATUS)
- M LRCMT=^LR(LRDFN,"MI",LRIDT,15)
- ;
- S IEN=0
- F S IEN=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,15,IEN)) Q:IEN<1 D ;
- . S LRX=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,15,IEN,0),LRX=$S(LRX'="":LRX,1:" ")
- . I LRX'=" ",$$DUPCHK^LRVRMI3(LRLL,LRPROF,.LRCMT,LRX) Q
- . S LRIEN="+"_IEN_","_LRIDT_","_LRDFN_","
- . S LRFDA(15,63.371,LRIEN,.01)=LRX
- ;
- I $D(LRFDA) D
- . D UPDATE^DIE("","LRFDA(15)","LRFDAIEN","LRMSG")
- . S IEN=0
- . F S IEN=$O(LRFDAIEN(IEN)) Q:'IEN I $G(LRPL) D SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_",15,"_LRFDAIEN(IEN),LRPL)
- ;
- K LRFDA,LRIEN,LRMSG,DIERR
- S LRIEN=LRIDT_","_LRDFN_","
- I LRINTYPE=10 S LRFDA(15,63.05,LRIEN,18)=LRNOW
- S LRFDA(15,63.05,LRIEN,19.5)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ))
- D FILE^DIE("","LRFDA(15)","LRMSG")
- S LRRPTAPP=1
- Q
- ;
- ;
- N18 ; Process Virology Rpt Remarks
- N DIERR,IEN,LRCMT,LRFDA,LRIEN,LRIENS,LRMSG,LRPL,LRX,STAT
- ;
- S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,18,0))
- S LRPL=$P(LRX,"^"),STAT=$P(LRX,U,4)
- D BLDSTAT^LRVRMI4A(63.05,34,STAT,.LRSTATUS)
- M LRCMT=^LR(LRDFN,"MI",LRIDT,18)
- ;
- S IEN=0
- F S IEN=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,18,IEN)) Q:IEN<1 D ;
- . S LRX=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,18,IEN,0),LRX=$S(LRX'="":LRX,1:" ")
- . I LRX'=" ",$$DUPCHK^LRVRMI3(LRLL,LRPROF,.LRCMT,LRX) Q
- . S LRIEN="+"_IEN_","_LRIDT_","_LRDFN_","
- . S LRFDA(18,63.44,LRIEN,.01)=LRX
- I $D(LRFDA) D
- . D UPDATE^DIE("","LRFDA(18)","LRFDAIEN","LRMSG")
- . S IEN=0
- . F S IEN=$O(LRFDAIEN(IEN)) Q:'IEN I $G(LRPL) D SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_",18,"_LRFDAIEN(IEN),LRPL)
- ;
- K LRFDA,LRIEN,LRMSG,DIERR
- S LRIEN=LRIDT_","_LRDFN_","
- I LRINTYPE=10 S LRFDA(18,63.05,LRIEN,33)=LRNOW
- S LRFDA(18,63.05,LRIEN,35)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ))
- D FILE^DIE("","LRFDA(18)","LRMSG")
- S LRRPTAPP=1
- Q
- ;
- ;
- HEAD ;
- ; Start by getting the demographic data from LAH
- S EOL=$G(^LAH(LWL,1,ISQN,.1,"OBR","EOL"))
- S FID=$G(^LAH(LWL,1,ISQN,.1,"OBR","FID"))
- S ORCDT=$G(^LAH(LWL,1,ISQN,.1,"OBR","ORCDT"))
- S ORDNLT=$G(^LAH(LWL,1,ISQN,.1,"OBR","ORDNLT"))
- S ORDP=$G(^LAH(LWL,1,ISQN,.1,"OBR","ORDP"))
- S PEB=$G(^LAH(LWL,1,ISQN,.1,"OBR","PEB"))
- S PVB=$G(^LAH(LWL,1,ISQN,.1,"OBR","PVB"))
- S SID=$G(^LAH(LWL,1,ISQN,.1,"OBR","SID"))
- S DFN=$G(^LAH(LWL,1,ISQN,.1,"PID","DFN"))
- S DOB=$G(^LAH(LWL,1,ISQN,.1,"PID","DOB"))
- S ICN=$G(^LAH(LWL,1,ISQN,.1,"PID","ICN"))
- S LRTDFN=$G(^LAH(LWL,1,ISQN,.1,"PID","LRTDFN"))
- S PNM=$G(^LAH(LWL,1,ISQN,.1,"PID","PNM"))
- S SEX=$G(^LAH(LWL,1,ISQN,.1,"PID","SEX"))
- S SSN=$G(^LAH(LWL,1,ISQN,.1,"PID","SSN"))
- S LRUID=$G(^LAH(LWL,1,ISQN,.3))
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRVRMI2 5968 printed Dec 13, 2024@02:22:50 Page 2
- 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
- +2 ;
- +3 ; Continuation of LRVRMI4 and is used for extracting results from the LAH global and storing it into LAB DATA FILE (#63).
- +4 ;
- +5 QUIT
- +6 ;
- N7 ; Process Parasite Remarks
- +1 NEW DIERR,IEN,LRCMT,LRFDA,LRFDAIEN,LRIEN,LRIENS,LRMSG,LRPL,LRX,X,STAT
- +2 SET LRX=$GET(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,7,0))
- +3 SET LRPL=$PIECE(LRX,"^")
- SET STAT=$PIECE(LRX,"^",4)
- +4 DO BLDSTAT^LRVRMI4A(63.05,15,STAT,.LRSTATUS)
- +5 MERGE LRCMT=^LR(LRDFN,"MI",LRIDT,7)
- +6 ;
- +7 SET IEN=0
- +8 ;
- FOR
- SET IEN=$ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,7,IEN))
- if IEN<1
- QUIT
- Begin DoDot:1
- +9 SET LRX=^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,7,IEN,0)
- SET LRX=$SELECT(LRX'="":LRX,1:" ")
- +10 IF LRX'=" "
- IF $$DUPCHK^LRVRMI3(LRLL,LRPROF,.LRCMT,LRX)
- QUIT
- +11 SET LRIEN="+"_IEN_","_LRIDT_","_LRDFN_","
- +12 SET LRFDA(7,63.36,LRIEN,.01)=LRX
- End DoDot:1
- +13 ;
- +14 IF $DATA(LRFDA)
- Begin DoDot:1
- +15 DO UPDATE^DIE("","LRFDA(7)","LRFDAIEN","LRMSG")
- +16 SET IEN=0
- +17 FOR
- SET IEN=$ORDER(LRFDAIEN(IEN))
- if 'IEN
- QUIT
- IF $GET(LRPL)
- DO SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_",7,"_LRFDAIEN(IEN),LRPL)
- End DoDot:1
- +18 ;
- +19 KILL LRFDA,LRIEN,LRMSG,DIERR
- +20 SET LRIEN=LRIDT_","_LRDFN_","
- +21 IF LRINTYPE=10
- SET LRFDA(7,63.05,LRIEN,14)=LRNOW
- +22 SET LRFDA(7,63.05,LRIEN,15.5)=$SELECT($GET(LRDUZ):LRDUZ,1:$GET(DUZ))
- +23 DO FILE^DIE("","LRFDA(7)","LRMSG")
- +24 SET LRRPTAPP=1
- +25 QUIT
- +26 ;
- +27 ;
- N10 ; Process Mycology Remarks
- +1 NEW DIERR,IEN,LRCMT,LRFDA,LRIEN,LRIENS,LRMSG,LRPL,LRX,STAT
- +2 SET LRX=$GET(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,10,0))
- +3 SET LRPL=$PIECE(LRX,"^")
- SET STAT=$PIECE(LRX,U,4)
- +4 DO BLDSTAT^LRVRMI4A(63.05,19,STAT,.LRSTATUS)
- +5 MERGE LRCMT=^LR(LRDFN,"MI",LRIDT,10)
- +6 ;
- +7 SET IEN=0
- +8 FOR
- SET IEN=$ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,10,IEN))
- if IEN<1
- QUIT
- Begin DoDot:1
- +9 SET LRX=^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,10,IEN,0)
- SET LRX=$SELECT(LRX'="":LRX,1:" ")
- +10 IF LRX'=" "
- IF $$DUPCHK^LRVRMI3(LRLL,LRPROF,.LRCMT,LRX)
- QUIT
- +11 SET LRIEN="+"_IEN_","_LRIDT_","_LRDFN_","
- +12 SET LRFDA(10,63.38,LRIEN,.01)=LRX
- End DoDot:1
- +13 IF $DATA(LRFDA)
- Begin DoDot:1
- +14 DO UPDATE^DIE("","LRFDA(10)","LRFDAIEN","LRMSG")
- +15 SET IEN=0
- +16 FOR
- SET IEN=$ORDER(LRFDAIEN(IEN))
- if 'IEN
- QUIT
- IF $GET(LRPL)
- DO SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_",10,"_LRFDAIEN(IEN),LRPL)
- End DoDot:1
- +17 ;
- +18 KILL LRFDA,LRIEN,LRMSG,DIERR
- +19 SET LRIEN=LRIDT_","_LRDFN_","
- +20 IF LRINTYPE=10
- SET LRFDA(10,63.05,LRIEN,18)=LRNOW
- +21 SET LRFDA(10,63.05,LRIEN,19.5)=$SELECT($GET(LRDUZ):LRDUZ,1:$GET(DUZ))
- +22 DO FILE^DIE("","LRFDA(10)","LRMSG")
- +23 SET LRRPTAPP=1
- +24 QUIT
- +25 ;
- +26 ;
- N13 ; Process TB Rpt Remarks
- +1 NEW DIERR,IEN,LRCMT,LRFDA,LRIEN,LRIENS,LRMSG,LRPL,LRX,STAT
- +2 SET LRX=$GET(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,13,0))
- +3 SET LRPL=$PIECE(LRX,"^")
- SET STAT=$PIECE(LRX,U,4)
- +4 DO BLDSTAT^LRVRMI4A(63.05,23,STAT,.LRSTATUS)
- +5 MERGE LRCMT=^LR(LRDFN,"MI",LRIDT,13)
- +6 ;
- +7 SET IEN=0
- +8 FOR
- SET IEN=$ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,13,IEN))
- if IEN<1
- QUIT
- Begin DoDot:1
- +9 SET LRX=^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,13,IEN,0)
- SET LRX=$SELECT(LRX'="":LRX,1:" ")
- +10 IF LRX'=" "
- IF $$DUPCHK^LRVRMI3(LRLL,LRPROF,.LRCMT,LRX)
- QUIT
- +11 SET LRIEN="+"_IEN_","_LRIDT_","_LRDFN_","
- +12 SET LRFDA(13,63.41,LRIEN,.01)=LRX
- End DoDot:1
- +13 IF $DATA(LRFDA)
- Begin DoDot:1
- +14 DO UPDATE^DIE("","LRFDA(13)","LRFDAIEN","LRMSG")
- +15 SET IEN=0
- +16 FOR
- SET IEN=$ORDER(LRFDAIEN(IEN))
- if 'IEN
- QUIT
- IF $GET(LRPL)
- DO SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_",13,"_LRFDAIEN(IEN),LRPL)
- End DoDot:1
- +17 ;
- +18 KILL LRFDA,LRIEN,LRMSG,DIERR
- +19 SET LRIEN=LRIDT_","_LRDFN_","
- +20 IF LRINTYPE=10
- SET LRFDA(13,63.05,LRIEN,22)=LRNOW
- +21 SET LRFDA(13,63.05,LRIEN,25.5)=$SELECT($GET(LRDUZ):LRDUZ,1:$GET(DUZ))
- +22 DO FILE^DIE("","LRFDA(13)","LRMSG")
- +23 SET LRRPTAPP=1
- +24 QUIT
- +25 ;
- +26 ;
- N15 ; Mycology smear/prep
- +1 NEW DIERR,IEN,LRCMT,LRFDA,LRIEN,LRIENS,LRMSG,LRPL,LRX
- +2 SET LRX=$GET(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,15,0))
- +3 SET LRPL=$PIECE(LRX,"^")
- SET STAT=$PIECE(LRX,U,4)
- +4 DO BLDSTAT^LRVRMI4A(63.05,19,STAT,.LRSTATUS)
- +5 MERGE LRCMT=^LR(LRDFN,"MI",LRIDT,15)
- +6 ;
- +7 SET IEN=0
- +8 ;
- FOR
- SET IEN=$ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,15,IEN))
- if IEN<1
- QUIT
- Begin DoDot:1
- +9 SET LRX=^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,15,IEN,0)
- SET LRX=$SELECT(LRX'="":LRX,1:" ")
- +10 IF LRX'=" "
- IF $$DUPCHK^LRVRMI3(LRLL,LRPROF,.LRCMT,LRX)
- QUIT
- +11 SET LRIEN="+"_IEN_","_LRIDT_","_LRDFN_","
- +12 SET LRFDA(15,63.371,LRIEN,.01)=LRX
- End DoDot:1
- +13 ;
- +14 IF $DATA(LRFDA)
- Begin DoDot:1
- +15 DO UPDATE^DIE("","LRFDA(15)","LRFDAIEN","LRMSG")
- +16 SET IEN=0
- +17 FOR
- SET IEN=$ORDER(LRFDAIEN(IEN))
- if 'IEN
- QUIT
- IF $GET(LRPL)
- DO SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_",15,"_LRFDAIEN(IEN),LRPL)
- End DoDot:1
- +18 ;
- +19 KILL LRFDA,LRIEN,LRMSG,DIERR
- +20 SET LRIEN=LRIDT_","_LRDFN_","
- +21 IF LRINTYPE=10
- SET LRFDA(15,63.05,LRIEN,18)=LRNOW
- +22 SET LRFDA(15,63.05,LRIEN,19.5)=$SELECT($GET(LRDUZ):LRDUZ,1:$GET(DUZ))
- +23 DO FILE^DIE("","LRFDA(15)","LRMSG")
- +24 SET LRRPTAPP=1
- +25 QUIT
- +26 ;
- +27 ;
- N18 ; Process Virology Rpt Remarks
- +1 NEW DIERR,IEN,LRCMT,LRFDA,LRIEN,LRIENS,LRMSG,LRPL,LRX,STAT
- +2 ;
- +3 SET LRX=$GET(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,18,0))
- +4 SET LRPL=$PIECE(LRX,"^")
- SET STAT=$PIECE(LRX,U,4)
- +5 DO BLDSTAT^LRVRMI4A(63.05,34,STAT,.LRSTATUS)
- +6 MERGE LRCMT=^LR(LRDFN,"MI",LRIDT,18)
- +7 ;
- +8 SET IEN=0
- +9 ;
- FOR
- SET IEN=$ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,18,IEN))
- if IEN<1
- QUIT
- Begin DoDot:1
- +10 SET LRX=^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,18,IEN,0)
- SET LRX=$SELECT(LRX'="":LRX,1:" ")
- +11 IF LRX'=" "
- IF $$DUPCHK^LRVRMI3(LRLL,LRPROF,.LRCMT,LRX)
- QUIT
- +12 SET LRIEN="+"_IEN_","_LRIDT_","_LRDFN_","
- +13 SET LRFDA(18,63.44,LRIEN,.01)=LRX
- End DoDot:1
- +14 IF $DATA(LRFDA)
- Begin DoDot:1
- +15 DO UPDATE^DIE("","LRFDA(18)","LRFDAIEN","LRMSG")
- +16 SET IEN=0
- +17 FOR
- SET IEN=$ORDER(LRFDAIEN(IEN))
- if 'IEN
- QUIT
- IF $GET(LRPL)
- DO SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_",18,"_LRFDAIEN(IEN),LRPL)
- End DoDot:1
- +18 ;
- +19 KILL LRFDA,LRIEN,LRMSG,DIERR
- +20 SET LRIEN=LRIDT_","_LRDFN_","
- +21 IF LRINTYPE=10
- SET LRFDA(18,63.05,LRIEN,33)=LRNOW
- +22 SET LRFDA(18,63.05,LRIEN,35)=$SELECT($GET(LRDUZ):LRDUZ,1:$GET(DUZ))
- +23 DO FILE^DIE("","LRFDA(18)","LRMSG")
- +24 SET LRRPTAPP=1
- +25 QUIT
- +26 ;
- +27 ;
- HEAD ;
- +1 ; Start by getting the demographic data from LAH
- +2 SET EOL=$GET(^LAH(LWL,1,ISQN,.1,"OBR","EOL"))
- +3 SET FID=$GET(^LAH(LWL,1,ISQN,.1,"OBR","FID"))
- +4 SET ORCDT=$GET(^LAH(LWL,1,ISQN,.1,"OBR","ORCDT"))
- +5 SET ORDNLT=$GET(^LAH(LWL,1,ISQN,.1,"OBR","ORDNLT"))
- +6 SET ORDP=$GET(^LAH(LWL,1,ISQN,.1,"OBR","ORDP"))
- +7 SET PEB=$GET(^LAH(LWL,1,ISQN,.1,"OBR","PEB"))
- +8 SET PVB=$GET(^LAH(LWL,1,ISQN,.1,"OBR","PVB"))
- +9 SET SID=$GET(^LAH(LWL,1,ISQN,.1,"OBR","SID"))
- +10 SET DFN=$GET(^LAH(LWL,1,ISQN,.1,"PID","DFN"))
- +11 SET DOB=$GET(^LAH(LWL,1,ISQN,.1,"PID","DOB"))
- +12 SET ICN=$GET(^LAH(LWL,1,ISQN,.1,"PID","ICN"))
- +13 SET LRTDFN=$GET(^LAH(LWL,1,ISQN,.1,"PID","LRTDFN"))
- +14 SET PNM=$GET(^LAH(LWL,1,ISQN,.1,"PID","PNM"))
- +15 SET SEX=$GET(^LAH(LWL,1,ISQN,.1,"PID","SEX"))
- +16 SET SSN=$GET(^LAH(LWL,1,ISQN,.1,"PID","SSN"))
- +17 SET LRUID=$GET(^LAH(LWL,1,ISQN,.3))
- +18 QUIT