LRVRMI3 ;DALOI/STAFF - LAB MICRO LEDI INTERFACE ;09/07/16 08:09
;;5.2;LAB SERVICE;**350,427,453,474**;Sep 27, 1994;Build 14
;
; Part of Micro LEDI interface. It is a continuation of ^LRVRMI4 and ^LRVRMI2. Processes data in the temp global ^TMP("LRMI")
; and stores it into the appropriate sections of the Lab Data Microbiology file (#63.05).
;
;
NODE(LRNODE) ; Process similar multiples - nodes 15,19-31
; Call with LRNODE = node in MI subscript to process
;
N DIERR,IEN,LRCMT,LRFDA,LRFDAIEN,LRFILE,LRERR,LRIEN,LRMSG,LRPL,LRX,X
; Mycology smear/prep^^^^Preliminary bacteriology comment^Preliminary virology comment^Preliminary parasite comment^Preliminary mycology comment^Preliminary TB comment^
; Parasitology smear/prep^Bacteriology smear/prep^Bacteriology test^Parasite test^Mycology test^TB test^Virology test^Sterility test
;
S LRFILE=$P("63.371^^^^63.06^63.431^63.1^63.11^63.18^63.341^63.291^63.061^63.361^63.111^63.181^63.432^63.292^","^",LRNODE-14)
M LRCMT=^LR(LRDFN,"MI",LRIDT,LRNODE)
;
S IEN=0
F S IEN=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,LRNODE,IEN)) Q:IEN<1 D
. S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,LRNODE,IEN,0)),LRX=$S(LRX'="":LRX,1:" ")
. I LRX'=" ",$$DUPCHK^LRVRMI3(LRLL,LRPROF,.LRCMT,LRX) Q
. S LRFDA(1,LRFILE,"+"_IEN_","_LRIDT_","_LRDFN_",",.01)=LRX
. ;S LRFDAIEN(IEN)=IEN
. ;
. ; if result came across in NTE, PL and status info will be under ^(0) node
. I $D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,LRNODE,0)) D ;
. . S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,LRNODE,0))
. . S X=$P(LRX,"^",4)
. . D STAT4CMT(LRFILE,X,.LRSTATUS)
. . I $P(LRX,"^") S LRPL(IEN)=$P(LRX,"^")
. ;
. ; if result came across in OBX, PL and status info will be under ^(IEN,0,0) node
. I $D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,LRNODE,IEN,0,0)) D ;
. . S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,LRNODE,IEN,0,0))
. . S X=$P(LRX,"^",4)
. . D STAT4CMT(LRFILE,X,.LRSTATUS)
. . I $P(LRX,"^") S LRPL(IEN)=$P(LRX,"^")
. ;
;
I '$D(LRFDA) Q
;
D UPDATE^DIE("","LRFDA(1)","LRFDAIEN","LRERR")
S IEN=0
F S IEN=$O(LRPL(IEN)) Q:'IEN D
. I $G(LRFDAIEN(IEN)) D SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_","_LRNODE_","_LRFDAIEN(IEN),LRPL(IEN))
;
;
; Update d/t approved and user approving
S LRX=$$RPTDT(LRDFN,LRIDT,LRNODE,LRNOW,$S($G(LRDUZ):LRDUZ,1:$G(DUZ)))
;
Q
;
;
SETPL(NODE) ; Setup LRPL array
; Call with NODE = node in MI subscript to retrieve the performing lab
;
N LRX
S LRX=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,NODE,IEN,0,0)
I $P(LRX,"^") S LRPL(IEN)=$P(LRX,"^")
Q
;
;
STOREPL(NODE) ; Set performing lab
; Call with NODE = node in MI subscript to retrieve the performing lab
N IEN
S IEN=0
F S IEN=$O(LRPL(IEN)) Q:'IEN I $G(LRFDAIEN(IEN)) D SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_","_NODE_","_LRFDAIEN(IEN),LRPL(IEN))
Q
;
;
DUPCHK(LRLL,LRPROF,LRCMT,LRCOM) ; Check for duplicates - comment stripped if spaces, force to upper case unless
; flag set to store duplicates (Field #2.2 of PROFILE multiple in file #68.2)
;
; Call with LRLL = load/work list ien
; LRPROF = profile ien in load/worklist
; LRCMT = array containing current comments on file
; LRCOM = new comment to check
;
; Returns LRDUP = 0 (no duplicate), 1 (duplicate)
;
N LRDUP,LRI,LRX,LRY
S LRDUP=0
I '$P($G(^LRO(68.2,LRLL,10,+$G(LRPROF),0)),U,4) D
. S LRI=0,LRY=$TR(LRCOM," ",""),LRY=$$UP^XLFSTR(LRY)
. F S LRI=$O(LRCMT(LRI)) Q:'LRI D Q:LRDUP
. . S LRX=$P(LRCMT(LRI,0),U),LRX=$TR(LRX," ",""),LRX=$$UP^XLFSTR(LRX)
. . I LRX=LRY S LRDUP=1
Q LRDUP
;
;
STAT4CMT(FILE,STAT,LRSTATUS) ; Calculate status for comment nodes (eg BACT SMEAR)
; Inputs
; FILE: The file # of the comment field in #63.
; STAT: The status (eg F)
; LRSTATUS:<byref> Input and Output
; Outputs
; LRSTATUS:
N SUBF,FLD
S (FLD,SUBF)=""
;
I FILE=63.291 S SUBF=63.05,FLD=11.5 ; Bact Smear
I FILE=63.341 S SUBF=63.05,FLD=15 ; Para Smear
I FILE=63.371 S SUBF=63.05,FLD=19 ; Myco Smear
I FILE=63.06 S SUBF=63.05,FLD=11.5 ; preliminary bacteria comment
I FILE=63.431 S SUBF=63.05,FLD=34 ; preliminary virus comment
I FILE=63.1 S SUBF=63.05,FLD=15 ; preliminary parasite comment
I FILE=63.11 S SUBF=63.05,FLD=19 ; preliminary mycology comment
I FILE=63.18 S SUBF=63.05,FLD=23 ; preliminary TB comment
I FILE=63.061 S SUBF=63.05,FLD=11.5 ; bacteria tests
I FILE=63.361 S SUBF=63.05,FLD=15 ; parasitology tests
I FILE=63.111 S SUBF=63.05,FLD=19 ; mycology tests
I FILE=63.181 S SUBF=63.05,FLD=23 ; TB tests
I FILE=63.432 S SUBF=63.05,FLD=34 ; virology tests
I FILE=63.292 S SUBF=63.05,FLD=11.5 ; sterility tests
;
I FLD,SUBF D BLDSTAT^LRVRMI4A(SUBF,FLD,STAT,.LRSTATUS)
;
Q
;
;
RPTDT(LRDFN,LRIDT,SUBSCR,RPTDT,USER) ; File Report Approved Date and Person Reporting
; Inputs
; LRDFN: LRDFN
; LRIDT: LRIDT
; SUBSCR: MI Result Subscript (eg 19,21,23,24,25,26)
; RPTDT: Report Approved Date/Time
; USER: Person Reporting (#200)
; Outputs
; Returns 0^ErrNum^ErrMsg on error, 1 on success
N DIERR,FLDS,IEN,LRFDA,LRMSG,LRX
;
S LRDFN=$G(LRDFN),LRIDT=$G(LRIDT),SUBSCR=$G(SUBSCR),(FLDS,LRX)=""
;
I $G(RPTDT)'>0 S RPTDT=$$NOW^XLFDT()
I $G(USER)="" S USER=$S($G(LRDUZ):LRDUZ,1:$G(DUZ))
I LRDFN,LRIDT,SUBSCR S FLDS=$$NODE2FLD(SUBSCR)
;
I FLDS'="" D
. S IEN=LRIDT_","_LRDFN_","
. I LRINTYPE=10 S LRFDA(1,63.05,IEN,$P(FLDS,"^",1))=RPTDT
. S LRFDA(1,63.05,IEN,$P(FLDS,"^",2))=USER
. D FILE^DIE("","LRFDA(1)","LRMSG")
. I '$D(LRMSG) S LRX=1,LRRPTAPP=1 Q
. S LRX="0^2^FileMan error"
E S LRX="0^1^No Field #s found"
;
Q LRX
;
;
NODE2FLD(NODE) ; Resolve the fields to update based on the node
; Call with NODE = node in MI subscript to process
;
; Returns FIELDS = Report Date Approved^Person Reporting field #s
;
N FIELDS
S NODE=$G(NODE),FIELDS=""
;
I NODE'="" D
. I NODE?1(1"19",1"25",1"26",1"31") S FIELDS="11^11.55" Q
. I NODE?1(1"23",1"29") S FIELDS="22^25.5" Q
. I NODE?1(1"21",1"24",1"27") S FIELDS="14^15.5" Q
. I NODE?1(1"15",1"22",1"28") S FIELDS="18^19.5" Q
. I NODE?1(1"20",1"30") S FIELDS="33^35" Q
;
Q FIELDS
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRVRMI3 6159 printed Oct 16, 2024@18:23:36 Page 2
LRVRMI3 ;DALOI/STAFF - LAB MICRO LEDI INTERFACE ;09/07/16 08:09
+1 ;;5.2;LAB SERVICE;**350,427,453,474**;Sep 27, 1994;Build 14
+2 ;
+3 ; Part of Micro LEDI interface. It is a continuation of ^LRVRMI4 and ^LRVRMI2. Processes data in the temp global ^TMP("LRMI")
+4 ; and stores it into the appropriate sections of the Lab Data Microbiology file (#63.05).
+5 ;
+6 ;
NODE(LRNODE) ; Process similar multiples - nodes 15,19-31
+1 ; Call with LRNODE = node in MI subscript to process
+2 ;
+3 NEW DIERR,IEN,LRCMT,LRFDA,LRFDAIEN,LRFILE,LRERR,LRIEN,LRMSG,LRPL,LRX,X
+4 ; Mycology smear/prep^^^^Preliminary bacteriology comment^Preliminary virology comment^Preliminary parasite comment^Preliminary mycology comment^Preliminary TB comment^
+5 ; Parasitology smear/prep^Bacteriology smear/prep^Bacteriology test^Parasite test^Mycology test^TB test^Virology test^Sterility test
+6 ;
+7 SET LRFILE=$PIECE("63.371^^^^63.06^63.431^63.1^63.11^63.18^63.341^63.291^63.061^63.361^63.111^63.181^63.432^63.292^","^",LRNODE-14)
+8 MERGE LRCMT=^LR(LRDFN,"MI",LRIDT,LRNODE)
+9 ;
+10 SET IEN=0
+11 FOR
SET IEN=$ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,LRNODE,IEN))
if IEN<1
QUIT
Begin DoDot:1
+12 SET LRX=$GET(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,LRNODE,IEN,0))
SET LRX=$SELECT(LRX'="":LRX,1:" ")
+13 IF LRX'=" "
IF $$DUPCHK^LRVRMI3(LRLL,LRPROF,.LRCMT,LRX)
QUIT
+14 SET LRFDA(1,LRFILE,"+"_IEN_","_LRIDT_","_LRDFN_",",.01)=LRX
+15 ;S LRFDAIEN(IEN)=IEN
+16 ;
+17 ; if result came across in NTE, PL and status info will be under ^(0) node
+18 ;
IF $DATA(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,LRNODE,0))
Begin DoDot:2
+19 SET LRX=$GET(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,LRNODE,0))
+20 SET X=$PIECE(LRX,"^",4)
+21 DO STAT4CMT(LRFILE,X,.LRSTATUS)
+22 IF $PIECE(LRX,"^")
SET LRPL(IEN)=$PIECE(LRX,"^")
End DoDot:2
+23 ;
+24 ; if result came across in OBX, PL and status info will be under ^(IEN,0,0) node
+25 ;
IF $DATA(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,LRNODE,IEN,0,0))
Begin DoDot:2
+26 SET LRX=$GET(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,LRNODE,IEN,0,0))
+27 SET X=$PIECE(LRX,"^",4)
+28 DO STAT4CMT(LRFILE,X,.LRSTATUS)
+29 IF $PIECE(LRX,"^")
SET LRPL(IEN)=$PIECE(LRX,"^")
End DoDot:2
+30 ;
End DoDot:1
+31 ;
+32 IF '$DATA(LRFDA)
QUIT
+33 ;
+34 DO UPDATE^DIE("","LRFDA(1)","LRFDAIEN","LRERR")
+35 SET IEN=0
+36 FOR
SET IEN=$ORDER(LRPL(IEN))
if 'IEN
QUIT
Begin DoDot:1
+37 IF $GET(LRFDAIEN(IEN))
DO SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_","_LRNODE_","_LRFDAIEN(IEN),LRPL(IEN))
End DoDot:1
+38 ;
+39 ;
+40 ; Update d/t approved and user approving
+41 SET LRX=$$RPTDT(LRDFN,LRIDT,LRNODE,LRNOW,$SELECT($GET(LRDUZ):LRDUZ,1:$GET(DUZ)))
+42 ;
+43 QUIT
+44 ;
+45 ;
SETPL(NODE) ; Setup LRPL array
+1 ; Call with NODE = node in MI subscript to retrieve the performing lab
+2 ;
+3 NEW LRX
+4 SET LRX=^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,NODE,IEN,0,0)
+5 IF $PIECE(LRX,"^")
SET LRPL(IEN)=$PIECE(LRX,"^")
+6 QUIT
+7 ;
+8 ;
STOREPL(NODE) ; Set performing lab
+1 ; Call with NODE = node in MI subscript to retrieve the performing lab
+2 NEW IEN
+3 SET IEN=0
+4 FOR
SET IEN=$ORDER(LRPL(IEN))
if 'IEN
QUIT
IF $GET(LRFDAIEN(IEN))
DO SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_","_NODE_","_LRFDAIEN(IEN),LRPL(IEN))
+5 QUIT
+6 ;
+7 ;
DUPCHK(LRLL,LRPROF,LRCMT,LRCOM) ; Check for duplicates - comment stripped if spaces, force to upper case unless
+1 ; flag set to store duplicates (Field #2.2 of PROFILE multiple in file #68.2)
+2 ;
+3 ; Call with LRLL = load/work list ien
+4 ; LRPROF = profile ien in load/worklist
+5 ; LRCMT = array containing current comments on file
+6 ; LRCOM = new comment to check
+7 ;
+8 ; Returns LRDUP = 0 (no duplicate), 1 (duplicate)
+9 ;
+10 NEW LRDUP,LRI,LRX,LRY
+11 SET LRDUP=0
+12 IF '$PIECE($GET(^LRO(68.2,LRLL,10,+$GET(LRPROF),0)),U,4)
Begin DoDot:1
+13 SET LRI=0
SET LRY=$TRANSLATE(LRCOM," ","")
SET LRY=$$UP^XLFSTR(LRY)
+14 FOR
SET LRI=$ORDER(LRCMT(LRI))
if 'LRI
QUIT
Begin DoDot:2
+15 SET LRX=$PIECE(LRCMT(LRI,0),U)
SET LRX=$TRANSLATE(LRX," ","")
SET LRX=$$UP^XLFSTR(LRX)
+16 IF LRX=LRY
SET LRDUP=1
End DoDot:2
if LRDUP
QUIT
End DoDot:1
+17 QUIT LRDUP
+18 ;
+19 ;
STAT4CMT(FILE,STAT,LRSTATUS) ; Calculate status for comment nodes (eg BACT SMEAR)
+1 ; Inputs
+2 ; FILE: The file # of the comment field in #63.
+3 ; STAT: The status (eg F)
+4 ; LRSTATUS:<byref> Input and Output
+5 ; Outputs
+6 ; LRSTATUS:
+7 NEW SUBF,FLD
+8 SET (FLD,SUBF)=""
+9 ;
+10 ; Bact Smear
IF FILE=63.291
SET SUBF=63.05
SET FLD=11.5
+11 ; Para Smear
IF FILE=63.341
SET SUBF=63.05
SET FLD=15
+12 ; Myco Smear
IF FILE=63.371
SET SUBF=63.05
SET FLD=19
+13 ; preliminary bacteria comment
IF FILE=63.06
SET SUBF=63.05
SET FLD=11.5
+14 ; preliminary virus comment
IF FILE=63.431
SET SUBF=63.05
SET FLD=34
+15 ; preliminary parasite comment
IF FILE=63.1
SET SUBF=63.05
SET FLD=15
+16 ; preliminary mycology comment
IF FILE=63.11
SET SUBF=63.05
SET FLD=19
+17 ; preliminary TB comment
IF FILE=63.18
SET SUBF=63.05
SET FLD=23
+18 ; bacteria tests
IF FILE=63.061
SET SUBF=63.05
SET FLD=11.5
+19 ; parasitology tests
IF FILE=63.361
SET SUBF=63.05
SET FLD=15
+20 ; mycology tests
IF FILE=63.111
SET SUBF=63.05
SET FLD=19
+21 ; TB tests
IF FILE=63.181
SET SUBF=63.05
SET FLD=23
+22 ; virology tests
IF FILE=63.432
SET SUBF=63.05
SET FLD=34
+23 ; sterility tests
IF FILE=63.292
SET SUBF=63.05
SET FLD=11.5
+24 ;
+25 IF FLD
IF SUBF
DO BLDSTAT^LRVRMI4A(SUBF,FLD,STAT,.LRSTATUS)
+26 ;
+27 QUIT
+28 ;
+29 ;
RPTDT(LRDFN,LRIDT,SUBSCR,RPTDT,USER) ; File Report Approved Date and Person Reporting
+1 ; Inputs
+2 ; LRDFN: LRDFN
+3 ; LRIDT: LRIDT
+4 ; SUBSCR: MI Result Subscript (eg 19,21,23,24,25,26)
+5 ; RPTDT: Report Approved Date/Time
+6 ; USER: Person Reporting (#200)
+7 ; Outputs
+8 ; Returns 0^ErrNum^ErrMsg on error, 1 on success
+9 NEW DIERR,FLDS,IEN,LRFDA,LRMSG,LRX
+10 ;
+11 SET LRDFN=$GET(LRDFN)
SET LRIDT=$GET(LRIDT)
SET SUBSCR=$GET(SUBSCR)
SET (FLDS,LRX)=""
+12 ;
+13 IF $GET(RPTDT)'>0
SET RPTDT=$$NOW^XLFDT()
+14 IF $GET(USER)=""
SET USER=$SELECT($GET(LRDUZ):LRDUZ,1:$GET(DUZ))
+15 IF LRDFN
IF LRIDT
IF SUBSCR
SET FLDS=$$NODE2FLD(SUBSCR)
+16 ;
+17 IF FLDS'=""
Begin DoDot:1
+18 SET IEN=LRIDT_","_LRDFN_","
+19 IF LRINTYPE=10
SET LRFDA(1,63.05,IEN,$PIECE(FLDS,"^",1))=RPTDT
+20 SET LRFDA(1,63.05,IEN,$PIECE(FLDS,"^",2))=USER
+21 DO FILE^DIE("","LRFDA(1)","LRMSG")
+22 IF '$DATA(LRMSG)
SET LRX=1
SET LRRPTAPP=1
QUIT
+23 SET LRX="0^2^FileMan error"
End DoDot:1
+24 IF '$TEST
SET LRX="0^1^No Field #s found"
+25 ;
+26 QUIT LRX
+27 ;
+28 ;
NODE2FLD(NODE) ; Resolve the fields to update based on the node
+1 ; Call with NODE = node in MI subscript to process
+2 ;
+3 ; Returns FIELDS = Report Date Approved^Person Reporting field #s
+4 ;
+5 NEW FIELDS
+6 SET NODE=$GET(NODE)
SET FIELDS=""
+7 ;
+8 IF NODE'=""
Begin DoDot:1
+9 IF NODE?1(1"19",1"25",1"26",1"31")
SET FIELDS="11^11.55"
QUIT
+10 IF NODE?1(1"23",1"29")
SET FIELDS="22^25.5"
QUIT
+11 IF NODE?1(1"21",1"24",1"27")
SET FIELDS="14^15.5"
QUIT
+12 IF NODE?1(1"15",1"22",1"28")
SET FIELDS="18^19.5"
QUIT
+13 IF NODE?1(1"20",1"30")
SET FIELDS="33^35"
QUIT
End DoDot:1
+14 ;
+15 QUIT FIELDS
