- LR7OR3 ;slc/dcm - Get Lab TEST parameters ;8/11/97
- ;;5.2T9;LR;**1018**;Nov 17, 2004
- ;;5.2;LAB SERVICE;**121,187,245,256**;Sep 27, 1994
- ;Entry points: TEST - to get all TEST parameters
- ; COLL - to get collection sample & specimen parameters
- ; URG - to get urgency parameters
- GET(TEST) ;Get TEST ifn
- I '$D(TEST) Q ""
- I TEST'?1N.N S TEST=$O(^LAB(60,"B",TEST,0)) Q:'TEST ""
- I TEST?1N.N Q:'$D(^LAB(60,TEST)) ""
- Q TEST
- TEST(TEST,Y) ;Gets Lab Test ordering parameters from file 60
- ;TEST=Lab TEST (can be either name or internal #)
- ;Y("Unique CollSamp")=n
- ;Y("Default CollSamp")=n
- ;Y("Lab CollSamp")=n (Lab Collection Sample)
- ;Y("Default Urgency")=ptr 62.05^Name
- ;Y("Urgencies",n)=ptr 62.05^Name
- ;Y("Specimens",n)=ptr 61^Name
- ;Y("CollSamp",n)=ptr 62^Name^DefSpecimen^TubeColor^MaxOrd^MaxDay^LabCollect^ReqComID
- ;Y("CollSamp",n,"WD",i,0)=Ward Remarks
- ;Y("GenWardInstructions",n)=General Ward Instructions
- ;Y("ReqCom")=Required Comment ID at Test level
- N X0
- Q:'$D(TEST)
- S TEST=$$GET(TEST) Q:'TEST
- S X0=^LAB(60,TEST,0)
- D GCOM(TEST,.Y)
- D COLL(TEST,.Y)
- D URG(TEST,.Y)
- Q
- COLL(TEST,Y) ;Get Collection Sample-Specimen data
- N X0,I,J,X,SAMP,SPEC
- Q:'$D(TEST)
- S TEST=$$GET(TEST)
- Q:'TEST
- S X0=^LAB(60,TEST,0),I=0
- I $P(X0,"^",19) S Y("ReqCom")=$P($G(^LAB(62.07,+$P(X0,"^",19),0)),"^")
- F S I=$O(^LAB(60,TEST,3,I)) Q:I<1 S X=^(I,0),Y("CollSamp",I)=$$SAMP(X),Y("CollSamp")=+$G(Y("CollSamp"))+1,J=0 D
- . F S J=$O(^LAB(60,TEST,3,I,1,J)) Q:J<1 S Y("CollSamp",I,"WP",J,0)=^(J,0)
- I $O(^LAB(60,TEST,3,0)) S Y("Default CollSamp")=$O(^(0))
- S I=0 F S I=$O(^LAB(60,TEST,1,I)) Q:I<1 S X=^(I,0),Y("Specimens",I)=+X_"^"_$P($G(^LAB(61,+X,0)),"^"),Y("Specimens")=+$G(Y("Specimens"))+1
- I $P(X0,"^",8),$O(^LAB(60,TEST,3,0)) S Y("Unique CollSamp")=+$O(^(0))
- I $P(X0,"^",9) S I=0 F S I=$O(^LAB(60,TEST,3,I)) Q:I<1 S X=+^(I,0) I X=$P(X0,"^",9) S Y("Lab CollSamp")=I Q
- I $P(X0,"^",9),'$D(Y("Lab CollSamp")) S Y("Lab CollSamp")=999,Y("CollSamp",999)=$$SAMP($P(X0,"^",9)),Y("CollSamp")=+$G(Y("CollSamp"))+1
- Q
- URG(TEST,Y) ;Get Urgency params for TEST
- N X0,I,X,URG
- Q:'$D(TEST)
- S TEST=$$GET(TEST)
- Q:'TEST
- S X0=^LAB(60,TEST,0)
- I $P(X0,"^",18) S Y("Default Urgency")=$P(X0,"^",18)_"^"_$P($G(^LAB(62.05,+$P(X0,"^",18),0)),"^",1,2) Q
- S I=0 F S I=$O(^LAB(62.05,I)) Q:I<1!(I>49) I $P(X0,"^",16)'>I S Y("Urgencies",I)=I_"^"_$P(^(I,0),"^",1,2),Y("Urgencies")=+$G(Y("Urgencies"))+1
- Q
- SAMP(X) ;Build Collection Sample data
- ;SAMP(X,REQ) ;Build Collection Sample data
- ;X=zero node from ^LAB(60,TEST,3,ifn,0) or ptr to 62
- ;REQ=Required comment from $P(^LAB(60,TEST,0),"^",19)
- ;N X0,Y
- N X0,Y,REQ
- Q:'$D(^LAB(62,+X,0)) "" S X0=^(0)
- S REQ=+$P(X,"^",6),REQ=$S(REQ:$P($G(^LAB(62.07,REQ,0)),"^"),1:"")
- S Y=+X_"^"_$P(X0,"^")_"^"_$P(X0,"^",2)_"^"_$P(X0,"^",3)_"^"_$P(X,"^",5)_"^"_$P(X,"^",7)_"^"_$P(X0,"^",7)_"^"_REQ
- Q Y
- DEFURG() ;Get default urgency for lab
- Q $P($G(^LAB(69.9,1,3)),U,2)
- SCOM(TEST,SAMP,TEXT) ;Get Ward Remarks (specimen) & put in TEXT aray
- ;TEST=ptr to TEST in file 60
- ;SAMP=ptr to collection sample file 62
- N X
- S X=$O(^LAB(60,+$G(TEST),3,"B",+$G(SAMP),0))
- Q:'X
- M TEXT=^LAB(60,TEST,3,X,1)
- Q
- GCOM(TEST,TEXT) ;Get General Ward Instructions
- ;TEST=ptr to TEST in file 60
- Q:'$O(^LAB(60,+$G(TEST),6,0))
- M TEXT("GenWardInstructions")=^LAB(60,TEST,6)
- Q
- LR7OR3 ;slc/dcm - Get Lab TEST parameters ;8/11/97
- +1 ;;5.2T9;LR;**1018**;Nov 17, 2004
- +2 ;;5.2;LAB SERVICE;**121,187,245,256**;Sep 27, 1994
- +3 ;Entry points: TEST - to get all TEST parameters
- +4 ; COLL - to get collection sample & specimen parameters
- +5 ; URG - to get urgency parameters
- GET(TEST) ;Get TEST ifn
- +1 IF '$DATA(TEST)
- QUIT ""
- +2 IF TEST'?1N.N
- SET TEST=$ORDER(^LAB(60,"B",TEST,0))
- IF 'TEST
- QUIT ""
- +3 IF TEST?1N.N
- IF '$DATA(^LAB(60,TEST))
- QUIT ""
- +4 QUIT TEST
- TEST(TEST,Y) ;Gets Lab Test ordering parameters from file 60
- +1 ;TEST=Lab TEST (can be either name or internal #)
- +2 ;Y("Unique CollSamp")=n
- +3 ;Y("Default CollSamp")=n
- +4 ;Y("Lab CollSamp")=n (Lab Collection Sample)
- +5 ;Y("Default Urgency")=ptr 62.05^Name
- +6 ;Y("Urgencies",n)=ptr 62.05^Name
- +7 ;Y("Specimens",n)=ptr 61^Name
- +8 ;Y("CollSamp",n)=ptr 62^Name^DefSpecimen^TubeColor^MaxOrd^MaxDay^LabCollect^ReqComID
- +9 ;Y("CollSamp",n,"WD",i,0)=Ward Remarks
- +10 ;Y("GenWardInstructions",n)=General Ward Instructions
- +11 ;Y("ReqCom")=Required Comment ID at Test level
- +12 NEW X0
- +13 IF '$DATA(TEST)
- QUIT
- +14 SET TEST=$$GET(TEST)
- IF 'TEST
- QUIT
- +15 SET X0=^LAB(60,TEST,0)
- +16 DO GCOM(TEST,.Y)
- +17 DO COLL(TEST,.Y)
- +18 DO URG(TEST,.Y)
- +19 QUIT
- COLL(TEST,Y) ;Get Collection Sample-Specimen data
- +1 NEW X0,I,J,X,SAMP,SPEC
- +2 IF '$DATA(TEST)
- QUIT
- +3 SET TEST=$$GET(TEST)
- +4 IF 'TEST
- QUIT
- +5 SET X0=^LAB(60,TEST,0)
- SET I=0
- +6 IF $PIECE(X0,"^",19)
- SET Y("ReqCom")=$PIECE($GET(^LAB(62.07,+$PIECE(X0,"^",19),0)),"^")
- +7 FOR
- SET I=$ORDER(^LAB(60,TEST,3,I))
- IF I<1
- QUIT
- SET X=^(I,0)
- SET Y("CollSamp",I)=$$SAMP(X)
- SET Y("CollSamp")=+$GET(Y("CollSamp"))+1
- SET J=0
- Begin DoDot:1
- +8 FOR
- SET J=$ORDER(^LAB(60,TEST,3,I,1,J))
- IF J<1
- QUIT
- SET Y("CollSamp",I,"WP",J,0)=^(J,0)
- End DoDot:1
- +9 IF $ORDER(^LAB(60,TEST,3,0))
- SET Y("Default CollSamp")=$ORDER(^(0))
- +10 SET I=0
- FOR
- SET I=$ORDER(^LAB(60,TEST,1,I))
- IF I<1
- QUIT
- SET X=^(I,0)
- SET Y("Specimens",I)=+X_"^"_$PIECE($GET(^LAB(61,+X,0)),"^")
- SET Y("Specimens")=+$GET(Y("Specimens"))+1
- +11 IF $PIECE(X0,"^",8)
- IF $ORDER(^LAB(60,TEST,3,0))
- SET Y("Unique CollSamp")=+$ORDER(^(0))
- +12 IF $PIECE(X0,"^",9)
- SET I=0
- FOR
- SET I=$ORDER(^LAB(60,TEST,3,I))
- IF I<1
- QUIT
- SET X=+^(I,0)
- IF X=$PIECE(X0,"^",9)
- SET Y("Lab CollSamp")=I
- QUIT
- +13 IF $PIECE(X0,"^",9)
- IF '$DATA(Y("Lab CollSamp"))
- SET Y("Lab CollSamp")=999
- SET Y("CollSamp",999)=$$SAMP($PIECE(X0,"^",9))
- SET Y("CollSamp")=+$GET(Y("CollSamp"))+1
- +14 QUIT
- URG(TEST,Y) ;Get Urgency params for TEST
- +1 NEW X0,I,X,URG
- +2 IF '$DATA(TEST)
- QUIT
- +3 SET TEST=$$GET(TEST)
- +4 IF 'TEST
- QUIT
- +5 SET X0=^LAB(60,TEST,0)
- +6 IF $PIECE(X0,"^",18)
- SET Y("Default Urgency")=$PIECE(X0,"^",18)_"^"_$PIECE($GET(^LAB(62.05,+$PIECE(X0,"^",18),0)),"^",1,2)
- QUIT
- +7 SET I=0
- FOR
- SET I=$ORDER(^LAB(62.05,I))
- IF I<1!(I>49)
- QUIT
- IF $PIECE(X0,"^",16)'>I
- SET Y("Urgencies",I)=I_"^"_$PIECE(^(I,0),"^",1,2)
- SET Y("Urgencies")=+$GET(Y("Urgencies"))+1
- +8 QUIT
- SAMP(X) ;Build Collection Sample data
- +1 ;SAMP(X,REQ) ;Build Collection Sample data
- +2 ;X=zero node from ^LAB(60,TEST,3,ifn,0) or ptr to 62
- +3 ;REQ=Required comment from $P(^LAB(60,TEST,0),"^",19)
- +4 ;N X0,Y
- +5 NEW X0,Y,REQ
- +6 IF '$DATA(^LAB(62,+X,0))
- QUIT ""
- SET X0=^(0)
- +7 SET REQ=+$PIECE(X,"^",6)
- SET REQ=$SELECT(REQ:$PIECE($GET(^LAB(62.07,REQ,0)),"^"),1:"")
- +8 SET Y=+X_"^"_$PIECE(X0,"^")_"^"_$PIECE(X0,"^",2)_"^"_$PIECE(X0,"^",3)_"^"_$PIECE(X,"^",5)_"^"_$PIECE(X,"^",7)_"^"_$PIECE(X0,"^",7)_"^"_REQ
- +9 QUIT Y
- DEFURG() ;Get default urgency for lab
- +1 QUIT $PIECE($GET(^LAB(69.9,1,3)),U,2)
- SCOM(TEST,SAMP,TEXT) ;Get Ward Remarks (specimen) & put in TEXT aray
- +1 ;TEST=ptr to TEST in file 60
- +2 ;SAMP=ptr to collection sample file 62
- +3 NEW X
- +4 SET X=$ORDER(^LAB(60,+$GET(TEST),3,"B",+$GET(SAMP),0))
- +5 IF 'X
- QUIT
- +6 MERGE TEXT=^LAB(60,TEST,3,X,1)
- +7 QUIT
- GCOM(TEST,TEXT) ;Get General Ward Instructions
- +1 ;TEST=ptr to TEST in file 60
- +2 IF '$ORDER(^LAB(60,+$GET(TEST),6,0))
- QUIT
- +3 MERGE TEXT("GenWardInstructions")=^LAB(60,TEST,6)
- +4 QUIT
